访问:TableDef.fields集合中缺少条目



我正在使用VBA过程,通过修改现有表的TableDef将一些字段添加到现有表中。由于这些字段的名称可能在导入之间发生变化,我选择在添加新条目之前删除旧条目。下面的代码在从库表(P6 Files AC(中添加字段时没有问题。出错的地方在于删除现有条目。开头的计数总是给出正确的字段数。但是FOR EACH语句跳过了一些条目。重复运行代码,最终会删除所有符合条件的字段。

Set curdb = CurrentDb()
Set tdf = curdb.TableDefs("TASK")
Debug.Print tdf.Fields.Count
tdf.Fields.Refresh
For Each fld In tdf.Fields
Debug.Print fld.Name
If InStr(1, fld.Name, "AC#", vbTextCompare) > 0 Then tdf.Fields.Delete fld.Name
Next fld

'add the field from the P6 Files AC table
strSQL = "SELECT [P6 Files AC].Field_Name " & _
"FROM [P6 Files AC] " & _
"ORDER BY [P6 Files AC].Field_Name;"
Set newfields = curdb.OpenRecordset(strSQL, dbOpenSnapshot)
With newfields
Do Until .EOF()
tdf.Fields.Append tdf.CreateField(!field_name, dbText, 15)
.MoveNext
Loop
End With

我认为链接源表,然后在创建表查询中将其用作源会简单得多:

SELECT * 
INTO [TASK]
FROM [P6 Files AC];

它将覆盖现有的TASK表。

当您循环一个项目集合(如表中的字段(以删除它们时,您需要按相反的顺序执行,否则当前字段位置将与循环中考虑的位置不同步。试试类似的东西:

Sub sDeleteFields()
On Error GoTo E_Handle
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim lngCount As Long
Dim lngLoop1 As Long
Set db = CurrentDb
Set tdf = db.TableDefs("tblRatings")
lngCount = tdf.Fields.Count - 1
For lngLoop1 = lngCount To 0 Step -1
If InStr(tdf.Fields(lngLoop1).name, "AC#") > 0 Then
tdf.Fields.Delete tdf.Fields(lngLoop1).Name
End If
Next lngLoop1
tdf.Fields.Refresh
sExit:
On Error Resume Next
Set tdf = Nothing
Set db = Nothing
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "sDeleteFields", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub

请注意,字段是0索引的,因此第一个字段位于0位置,最后一个字段位于count-1位置。

问候,

最新更新