导入ACCESS数据速度太慢，求大神帮忙。

kohaddf

     各位大神，因为工作上要处理的数据的太多，用EXCEL处理太慢。自己在网上找了参照的教程弄了一个功能，主要是将一些固定的工作薄数据导入到ACCESS中，然后再进行操作。但是发现导入的速度太慢了，一万多条数据，耗时28分钟。。。至少都要有十几万的数据。。在这里求大神看看，是我的程序有哪些需要改进的地方，或者有没有其他可以提高速度的方式，前提是可以减少人工操作。
下面操作是打开指定文件，将数据库里面不存在的运单编号存入，有运单编号的查看扫描时间，取扫描时间比较大的数据。
    For Each selectfiles In fd.SelectedItems
        Workbooks.Open selectfiles
        arr0 = ActiveWorkbook.Sheets(1).Range("A1").CurrentRegion
        head = WorksheetFunction.Index(arr0, 1, 0)
        With rs
        For i = 2 To UBound(arr0, 1) Step 1
            arr1 = WorksheetFunction.Index(arr0, i, 0)
            Set rs = New ADODB.Recordset
            sql = "select * from " & djb & " where 运单编号=""" & arr1(1) & """"
            rs.Open sql, cnn, adOpenKeyset, adLockOptimistic
            If IsNumeric(arr1(1)) = False Or arr1(1) = "" Then
                Exit For
            ElseIf rs.RecordCount = 0 Then
                rs.AddNew head, arr1
                allcount = allcount + 1
             ElseIf rs.RecordCount > 0 Then

                If Format(rs.Fields(4), "yyyy-mm-dd hh:mm:ss") < Format(arr1(5), "yyyy-mm-dd hh:mm:ss") Then
                    For j = 1 To rs.Fields.Count
                        rs.Fields(j - 1) = arr1(j)
                    Next j
                    rs.Update
                    allcount = allcount + 1
                End If
            Else
            End If

            progressbar i, UBound(arr0, 1), ActiveWorkbook.Name
            DoEvents
        Next
        End With
        ActiveWorkbook.Close
    Next selectfiles

    'Set the object variable to Nothing.
    tim = Timer - tim
    MsgBox "导入完成,共导入" & allcount & "行数据，耗时" & Int(tim \ 3600) & "小时" & Int(tim Mod 3600) \ 60 & "分" & Int(tim Mod 60) & "秒"
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
    Set fd = Nothing

roych

创建那么多记录集，想快估计也快不到哪里去吧？
Set rs = New ADODB.Recordset
For Each selectfiles In fd.SelectedItems
        Workbooks.Open selectfiles
        arr0 = ActiveWorkbook.Sheets(1).Range("A1").CurrentRegion
        head = WorksheetFunction.Index(arr0, 1, 0)
        With rs
        For i = 2 To UBound(arr0, 1) Step 1
            arr1 = WorksheetFunction.Index(arr0, i, 0)
            
            sql = "select * from " & djb & " where 运单编号=""" & arr1(1) & """"
            rs.Open sql, cnn, adOpenKeyset, adLockOptimistic
            If IsNumeric(arr1(1)) = False Or arr1(1) = "" Then
                Exit For
            ElseIf rs.RecordCount = 0 Then
                rs.AddNew head, arr1
                allcount = allcount + 1
             ElseIf rs.RecordCount > 0 Then

                If Format(rs.Fields(4), "yyyy-mm-dd hh:mm:ss") < Format(arr1(5), "yyyy-mm-dd hh:mm:ss") Then
                    For j = 1 To rs.Fields.Count
                        rs.Fields(j - 1) = arr1(j)
                    Next j
                    rs.Update
                    allcount = allcount + 1
                End If
            Else
            End If

            progressbar i, UBound(arr0, 1), ActiveWorkbook.Name
            DoEvents        Next
        End With
       rs.close
        ActiveWorkbook.Close
    Next selectfiles

    'Set the object variable to Nothing.
    tim = Timer - tim
    MsgBox "导入完成,共导入" & allcount & "行数据，耗时" & Int(tim \ 3600) & "小时" & Int(tim Mod 3600) \ 60 & "分" & Int(tim Mod 60) & "秒"

    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
    Set fd = Nothing
可能改不了多少，如果可以最好用Access自身的功能来导入【例如先链接Excel表，再通过追加查询进行处理】。

Renco

从代码来看，你的数据比较规整，如果在ACCESS里做程序的话。效率会更高，但高主要不是在于代码方面
而是ACCESS有提供一种链接表方式，可以把比较规整的Excel的sheet在ACCESS里形成一个可以直接使用的表（就当作是一个快捷方式的表),使用起来，和正常表差不多
这样，在数据写入进，就不用着循环字段或数组了，并且，这个链接表，可以只建立一个，随使用更改链接地址就行，前提呢，你的EXCEL的sheet文件是规整的，比如第一行就是列名，后面的都 是数据行等

kohaddf

谢谢，两位。数据量太大了，用单个导入的确效率太慢了。我转入学习ACCESS了，谢谢！

Renco

kohaddf 发表于 2015-12-1 14:44
谢谢，两位。数据量太大了，用单个导入的确效率太慢了。我转入学习ACCESS了，谢谢！

这样的recordset+field的两项嵌套循环，哪种写法都快不到哪去啊。
在ACCESS里，从过程看来，Field可能可以不用，并且recordset也可以减少一些（至少时间上的那个判断就不用写了）