基于,Microsoft Access 如何知道为索引字段集合创建的字段与 TableDef 字段集合中的等效字段关联?
Even in 此 Microsoft 支持页面 https://support.microsoft.com/en-us/kb/217011,字段是created对于索引,然后附加到索引的字段集合:
...
'Copy Indexes
For I1 = 0 To SourceTableDef.Indexes.Count - 1
Set SI = SourceTableDef.Indexes(I1)
If Not SI.Foreign Then ' Foreign indexes are added by relationships
Set I = T.CreateIndex()
' Copy Jet Properties
On Error Resume Next
For P1 = 0 To I.Properties.Count - 1
I.Properties(P1).Value = SI.Properties(P1).Value
Next P1
On Error GoTo 0
' Copy Fields
For f1 = 0 To SI.Fields.Count - 1
Set F = T.CreateField(SI.Fields(f1).Name, T.Fields(SI.Fields(f1).Name).Type)
I.Fields.Append F
Next f1
T.Indexes.Append I
End If
Next I1
...
我不能简单地添加 TableDef 字段集合中的现有字段吗?这毫无意义,而且似乎缺乏凝聚力。
Update
我实际测试了代码here https://support.microsoft.com/en-us/kb/217011这基本上就是我想做的......但它失败并出现未定义对象错误:
Set F = T.CreateField(SI.Fields(f1).Name, T.Fields(SI.Fields(f1).Name).Type)
...当我们改变这一点时,我们会得到各种各样的乐趣。
(2016 年 5 月 23 日)此外,这个脚本似乎是错误的 - 第二个参数实际上不应该在那里,它是不必要的。省略它会导致进一步的错误!哈!我的尾巴在哪里?我感觉我应该去追它。
我的问题的解决方案
我决定跟随 HansUp 的领导并使用 DDL - 比尝试查找与对象操作相关的问题要容易得多(尽管在最终的代码设计中存在一定程度的问题)...
Option Compare Database
Public Const cFname As String = "drm\drmData2016.accdb"
Public Const cPropNotFound As Integer = 3270
Public Const cNotSupported As Integer = 3251
Public Const cInvalidOp As Integer = 3219
Public Sub GenerateTables()
OpenLog
'Initalise...
Dim db As Database
Dim tdb As Database
Dim ts As TableDef, tt As TableDef
Dim p As Property
Dim f As Field, ft As Field
Dim i As Index
Dim s As String, t As String
Dim x As Boolean
Set db = CurrentDb
If Dir$(cFname) <> "" Then Kill cFname
Set tdb = Application.DBEngine.CreateDatabase(cFname, dbLangGeneral, dbVersion140)
WriteLog "Created database " & cFname & "."
'Create the tables...
WriteLog "Creating TableDefs...", 1
For Each ts In db.TableDefs
If Not StartsWith(ts.Name, "msys", "~", "$", "Name AutoCorrect") And Not EndsWith(ts.Name, "_xrep") Then
s = "SELECT "
For Each f In ts.Fields
If Not StartsWith(f.Name, "s_", "S_") Then s = s & "[" & f.Name & "], "
Next f
s = Left$(s, Len(s) - 2) & " INTO [" & ts.Name & "] IN """ & cFname & """ FROM [" & ts.Name & "];"
On Error Resume Next
db.Execute s
If Err.Number = 0 Then
WriteLog "Created [" & ts.Name & "] using " & s, 2
Else
WriteLog "Failed to create [" & ts.Name & "].", 2
WriteLog "Error " & Err.Number & ": " & Err.Description, 3
WriteLog "SQL: " & s, 3
Err.Clear
End If
tdb.TableDefs.Refresh
On Error GoTo 0
End If
Next ts
'Copy the properties...
WriteLog "Tables...", 1
For Each ts In db.TableDefs
If Not StartsWith(ts.Name, "msys", "~", "$", "Name Autocorrect") And Not EndsWith(ts.Name, "_xrep") Then
Set tt = tdb.TableDefs(ts.Name)
WriteLog ts.Name, 2
WriteLog "Table Properties...", 3
'Table properties...
For Each p In ts.Properties
On Error Resume Next
tt.Properties(p.Name) = p.value
If Err.Number = 0 Then
WriteLog p.Name & " = " & p.value, 3
Else
WriteLog "Error setting " & p.Name, 3
WriteLog Err.Number & ": " & Err.Description, 4
Err.Clear
End If
On Error GoTo 0
Next p
'Field properties...
WriteLog "Fields...", 3
For Each f In ts.Fields
If Not StartsWith(f.Name, "s_") Then
Set ft = tt.Fields(f.Name)
WriteLog f.Name, 3
WriteLog "Properties...", 3
For Each p In f.Properties
On Error Resume Next
ft.Properties(p.Name).value = p.value
Select Case Err.Number
Case 0
'Normal...
WriteLog p.Name & " = " & p.value, 4
Case cPropNotFound
'Create the property...
Dim np As Property
Set np = ft.CreateProperty(p.Name, p.Type, p.value)
ft.Properties.Append np
ft.Properties.Refresh
WriteLog "Created property " & p.Name & ", value of " & p.value, 4
Case cNotSupported, cInvalidOp
'We're not worried about these values - simply skip over them...
Case Else
WriteLog "Failed to create or change property " & p.Name & ".", 4
WriteLog "Error " & Err.Number & ": " & Err.Description, 5
Err.Clear
End Select
On Error GoTo 0
Next p
End If
Next f
'Create the indexes...
WriteLog "Table indexes...", 2
For Each i In ts.Indexes
x = False
s = "CREATE "
If i.Unique Then s = s & "UNIQUE "
s = s & "INDEX [" & i.Name & "] ON [" & ts.Name & "] ("
For Each f In i.Fields
s = s & "[" & f.Name & "], "
'Just make sure we're not dealing with replication fields...
x = StartsWith(f.Name, "s_")
Next f
'We only want
If Not x Then
WriteLog i.Name, 3
s = Left$(s, Len(s) - 2) & ") "
If i.Primary Or i.IgnoreNulls Or i.Required Then
s = s & "WITH "
If i.Primary Then s = s & "PRIMARY "
If i.IgnoreNulls Then s = s & "IGNORE NULL "
If i.Required Then s = s & "DISALLOW NULL "
End If
s = s & ";"
On Error Resume Next
tdb.Execute s
Select Case Err.Number
'Note: used select case just in case I need to add extra error numbers...
Case 0
'Normal...
WriteLog "Created index [" & i.Name & "] using " & s, 4
Case Else
WriteLog "Failed to create index [" & ts.Name & "].", 4
WriteLog "Error " & Err.Number & ": " & Err.Description, 5
WriteLog "SQL: " & s, 3
Err.Clear
End Select
On Error GoTo 0
End If
Next i
End If
Next ts
'Belt and braces tidy-up...
Set p = Nothing
Set f = Nothing
Set ft = Nothing
Set i = Nothing
Set ts = Nothing
Set tt = Nothing
tdb.Close
Set tdb = Nothing
Set db = Nothing
WriteLog "Closed database."
WriteLog "Finished.", , False
CloseLog
End Sub