从Excel VBA更新访问 - 非常慢

Question

我有下面的一段代码将新数据追加到现有的Access表。

需要大约35-40分钟，我上传约6000条记录...

感谢所有帮助...

Sub Upload(Process_ID) 

Dim Conn_DB As ADODB.Connection, CmdQuery As ADODB.Command, RecSet As ADODB.Recordset, StrSQL As String 
Dim LastColumn As Integer, LastRow As Integer, ImportData(), I As Integer, ArrayRow As Integer 

WS_Source.Select 
LastRow = WS_Source.Cells(Rows.Count, 1).End(xlUp).Row 
LastColumn = WS_Source.Cells(1, Columns.Count).End(xlToLeft).Column 

'Load source data to array 
ReDim ImportData(LastRow - 2, 25) 
Select Case Process_ID 
    Case 1, 2, 3 
     For I = 2 To LastRow 
      ImportData(ArrayRow, 0) = Cells(I, 1) 'username 
      ImportData(ArrayRow, 1) = Cells(I, 2) 'creid 
      ImportData(ArrayRow, 2) = Cells(I, 3) 'roleid 
      ImportData(ArrayRow, 3) = Cells(I, 4) 'webtraceid 
      ImportData(ArrayRow, 4) = Cells(I, 5) 'timestamp 
      ImportData(ArrayRow, 5) = Cells(I, 6) 'action 
      ImportData(ArrayRow, 6) = Cells(I, 7) 'Anti Fact 
      ImportData(ArrayRow, 7) = Cells(I, 8) 'sourceid 
      ImportData(ArrayRow, 8) = Cells(I, 9) 'source 
      ImportData(ArrayRow, 9) = Cells(I, 10) 'personid 
      ImportData(ArrayRow, 10) = Cells(I, 11) 'personname 
      ImportData(ArrayRow, 11) = Cells(I, 12) 'orgid 
      ImportData(ArrayRow, 12) = Cells(I, 13) 'orgname 
      ImportData(ArrayRow, 13) = Cells(I, 14) 'rel type 
      ImportData(ArrayRow, 14) = Cells(I, 15) 'oldvalue 
      ImportData(ArrayRow, 15) = Cells(I, 16) 'new value 
      ImportData(ArrayRow, 16) = Cells(I, 17) 'startdate 
      ImportData(ArrayRow, 17) = Cells(I, 18) 'enddate 
      ImportData(ArrayRow, 18) = Cells(I, 19) 'status 
      ImportData(ArrayRow, 19) = Cells(I, 20) 'sourcetype 
      ImportData(ArrayRow, 20) = Cells(I, 21) 'final score 
      ImportData(ArrayRow, 21) = Cells(I, 22) 'ben 
      ImportData(ArrayRow, 22) = Cells(I, 23) 'wpc 
      ImportData(ArrayRow, 23) = Cells(I, 24) 'prw 
      ImportData(ArrayRow, 24) = Cells(I, 26) 'serial 
      ImportData(ArrayRow, 25) = Cells(I, 28) 'sample 

      ArrayRow = ArrayRow + 1 
     Next I 
    Case Else: Exit Sub 
End Select 

'Load array data to database 
Set Conn_DB = New ADODB.Connection 
With Conn_DB 
    .Provider = "microsoft.ACE.OLEDB.12.0" 
    .ConnectionString = Location_DataBase 
End With 
Conn_DB.Open 

StrSQL = "SELECT *" 
Set CmdQuery = New ADODB.Command 
With CmdQuery 
    .ActiveConnection = Conn_DB 
    .CommandText = StrSQL 
    .CommandType = adCmdText 
End With 

For I = 0 To ArrayRow - 1 
    Set RecSet = New ADODB.Recordset 
    With RecSet 
     Set .Source = CmdQuery 
     .CursorType = adOpenKeyset 
     .CursorLocation = adUseClient 
     .LockType = adLockOptimistic 
     .Open "tbl_crereport" 
    End With 
    If RecSet.State = adStateOpen Then 
     With RecSet 
      .AddNew 
      Select Case Process_ID 
       Case 1, 2, 3 
        .Fields("processedby") = ImportData(I, 0) 
        .Fields("creid") = ImportData(I, 1) 
        .Fields("roleid") = ImportData(I, 2) 
        .Fields("webtraceid") = ImportData(I, 3) 
        .Fields("processeddate") = ImportData(I, 4) 
        .Fields("action") = ImportData(I, 5) 
        .Fields("antifact") = ImportData(I, 6) 
        .Fields("sourceid") = ImportData(I, 7) 
        .Fields("source") = ImportData(I, 8) 
        .Fields("personid") = ImportData(I, 9) 
        .Fields("personname") = ImportData(I, 10) 
        .Fields("orgid") = ImportData(I, 11) 
        .Fields("orgname") = ImportData(I, 12) 
        .Fields("relationshiptype") = ImportData(I, 13) 
        .Fields("oldvalue") = ImportData(I, 14) 
        .Fields("newvalue") = ImportData(I, 15) 
        .Fields("startdate") = ImportData(I, 16) 
        .Fields("enddate") = ImportData(I, 17) 
        .Fields("crestatus") = ImportData(I, 18) 
        .Fields("sourcetype") = ImportData(I, 19) 
        .Fields("finalscore") = ImportData(I, 20) 
        .Fields("ben") = ImportData(I, 21) 
        .Fields("wpc") = ImportData(I, 22) 
        .Fields("prw") = ImportData(I, 23) 
        .Fields("Serial") = ImportData(I, 24) 
        .Fields("sample") = ImportData(I, 25) 

        .Fields("allocatedto") = User_ID 
        .Fields("allocationdate") = Now() 
        .Fields("updatedby") = User_ID 
        .Fields("updatedate") = Now() 
        .Fields("status") = 1 
       Case Else: Exit Sub 
      End Select 
      .Update 
     End With 
    End If 
    RecSet.Close 
    Set RecSet = Nothing 
Next I 

'Close database 
On Error Resume Next 
RecSet.Close 
Conn_DB.Close 
Set CmdQuery = Nothing 
Set RecSet = Nothing 
Set Conn_DB = Nothing 

End Sub 

感谢所有帮助用来加快代码。

我不能以当前速度使用它。

感谢， 摹

Answer 1

3个小tips：

• 如果您在Access中有索引，追加/更新可以成为显著慢于你所期望的。在添加数据时，您可能想要删除这些索引。

• 你有没有尝试在Access中编写VBA？通过这种方式，您可以批量导入Excel文件，执行必要的数据处理并将其加载到您需要的表中（不按记录记录）。

• 我的VBA可能会生锈，但我认为您不必为每个正在追加的新记录创建一个记录集。循环之前创建一次，直到所有的记录都在加载只是不要关闭它

问候，