大型记录集（VBA）的MS Access插入速度慢

Question

我有一段代码创建一个新表，然后尝试将记录集值复制到表中。唯一的问题是它运行速度很慢，并且在执行下面的插入部分时访问会显示加载符号。当前，此问题正在插入500条记录，但是当我获得最终数据集时，我将需要插入大约10,000到20,000。

I = 1
DoCmd.SetWarnings False
RecordSet1.MoveFirst
Do While Not RecordSet1.EOF = True
    SQL = "INSERT INTO " & FullName & " ("
    For Each field In RecordSet1.fields()
        SQL = SQL & " " & Replace(field.Name, ".", "_") & ","
    Next field
    SQL = SQL & "ValidationCheck)"
    SQL = SQL & " VALUES("
    For Each field2 In RecordSet1.fields()
        SQL = SQL & "'" & field2.Value & "',"
    Next field2
    SQL = SQL & Matches(I) & ")"
    DoCmd.RunSQL (SQL)
    RecordSet1.MoveNext
    I = I + 1
Loop

我想知道的是，有什么办法可以加快速度吗？还是有更好的方法？（我想做的是在运行时从RecordSet中创建具有唯一字段集的表，并为每个Record添加一个具有布尔值的额外列，该布尔值存储在Match数组中）。创建工作正常，但是上面的插入代码非常慢。

Answer 1

是的，请使用DAO。这么快。此示例复制到同一张表，但是您可以轻松地对其进行修改，因此可以在两个表之间复制：

Public Sub CopyRecords()

  Dim rstSource   As DAO.Recordset
  Dim rstInsert   As DAO.Recordset
  Dim fld         As DAO.Field
  Dim strSQL      As String
  Dim lngLoop     As Long
  Dim lngCount    As Long

  strSQL = "SELECT * FROM tblStatus WHERE Location = '" & _
                "DEFx" & "' Order by Total"

  Set rstInsert = CurrentDb.OpenRecordset(strSQL)
  Set rstSource = rstInsert.Clone
  With rstSource
    lngCount = .RecordCount
    For lngLoop = 1 To lngCount
      With rstInsert
        .AddNew
          For Each fld In rstSource.Fields
            With fld
              If .Attributes And dbAutoIncrField Then
                ' Skip Autonumber or GUID field.
              ElseIf .Name = "Total" Then
                ' Insert default value.
                rstInsert.Fields(.Name).Value = 0
              ElseIf .Name = "PROCESSED_IND" Then
                rstInsert.Fields(.Name).Value = vbNullString
              Else
                ' Copy field content.
                rstInsert.Fields(.Name).Value = .Value
              End If
            End With
          Next
        .Update
      End With
      .MoveNext
    Next
    rstInsert.Close
    .Close
  End With

  Set rstInsert = Nothing
  Set rstSource = Nothing

End Sub