Access与Excel、CSV互相导入时速度慢，请帮忙优化

Option Explicit     '强制定义变量名
Public strFile As String
Public strArray() As String
Public i As Long
Public n As Long
Public B As Long
Public BH As String
Public YesNo As Boolean
Public xlapp As Object      'Excel 对象
Public xlbook As Object     '工作簿
Public xlsheet As Object    '工作表
Public Function UpdateBom()
    Set con = New ADODB.Connection
    Set res = New ADODB.Recordset
    con.Open "provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & App.Path & "\Data.accdb"
    Set xlapp = CreateObject("Excel.Application")
    Set xlbook = xlapp.Workbooks.Open(SystemSet.DesignXL)    '这里是用文本框输入全文件路径为xlsx
    Set xlsheet = xlbook.Worksheets("任务表")
    xlapp.Visible = False
    SystemSet.Label(5).Caption = "从List.CSV导入到数据库，正在更新……"
    SystemSet.Label(5).Refresh
    XToS (DAT)
    SystemSet.Label(5).Caption = "从任务表删除已完成项，正在更新……"
    SystemSet.Label(5).Refresh
    GToS (DAT)
    SystemSet.Label(5).Caption = "导出未完成订单到任务表，正在更新……"
    SystemSet.Label(5).Refresh
    SToG (DAT)
    xlapp.Quit
    If res.State = adStateOpen Then res.Close
    If con.State = adStateOpen Then con.Close
    Set xlapp = Nothing
    Set res = Nothing
    Set con = Nothing
End FunctionPublic Function XToS(ByVal DAT As String) As ADODB.Recordset        '从计划表更新到数据库
    Dim FileNumber As Long, Filebyte() As Byte, Arr() As String
    FileNumber = FreeFile
    Open SystemSet.PlaneXL.Text For Binary As #FileNumber          '这里是通过文本框写全路径CSV
    ReDim Filebyte(1 To LOF(FileNumber))
    Get #FileNumber, , Filebyte
    Arr = Split(StrConv(Filebyte, vbUnicode), vbCrLf)
    SystemSet.Progress.Min = 0
    SystemSet.Progress.Max = UBound(Arr) - 1 '取得数据行数
    SystemSet.Progress.Value = SystemSet.Progress.Min
    Close #FileNumber
    
    res.Open "select * from 目录", con, 3, 3
    'On Error Resume Next
    If Not (res.EOF And res.BOF) Then
        res.MoveLast
        i = res.RecordCount
    End If
    res.Close
    Open SystemSet.PlaneXL.Text For Input As #1
    Line Input #1, strFile
    n = 0
    Do While Not EOF(1)
        Line Input #1, strFile
        strArray = Split(strFile, ",")
        res.Open "select * from 目录 where 型号='" & strArray(4) & "'", con, 3, 3
        n = n + 1
        SystemSet.Progress.Value = n
        If res.EOF And res.BOF Then
            i = i + 1
            If i > 100000 Then
                BH = Left("CA000", 7 - Len(No(i - 100000))) & No(i - 10000)
            Else
                BH = "C" & Format(i, "00000")
            End If
            res.AddNew
            res.Fields("编号") = BH
            res.Fields("型号") = strArray(4)
            res.Fields("下单时间") = CDate(strArray(11))
            If InStr(1, res.Fields("型号"), "2A") > 0 Then res.Fields("类别") = "拉杆缸"
            If InStr(1, res.Fields("型号"), "2H") > 0 Then res.Fields("类别") = "拉杆缸"
            If InStr(1, res.Fields("型号"), "3H") > 0 Then res.Fields("类别") = "拉杆缸"
            If InStr(1, res.Fields("型号"), "3L") > 0 Then res.Fields("类别") = "拉杆缸"
            If InStr(1, res.Fields("型号"), "HM") > 0 Then res.Fields("类别") = "拉杆缸"
            If InStr(1, res.Fields("型号"), "MM") > 0 Then res.Fields("类别") = "冶金缸"
            If InStr(1, res.Fields("型号"), "MR") > 0 Then res.Fields("类别") = "冶金缸"
            If InStr(1, res.Fields("型号"), "CHE") > 0 Then res.Fields("类别") = "方缸"
            If InStr(1, res.Fields("型号"), "CHD") > 0 Then res.Fields("类别") = "方缸"
            If InStr(1, res.Fields("型号"), "SKRP") > 0 Then res.Fields("类别") = "密封包"
            res.Update
        End If
        res.Close
    Loop
    If res.State = adStateOpen Then res.Close
    Close #1
End FunctionPublic Function GToS(ByVal DAT As String) As ADODB.Recordset        '从工作表更新到数据库
    n = xlsheet.Cells(1, 1).CurrentRegion.Rows.Count
    SystemSet.Progress.Min = 0
    SystemSet.Progress.Max = n '取得数据行数
    SystemSet.Progress.Value = SystemSet.Progress.Min
    
    For i = 2 To n
        SystemSet.Progress.Value = i
        If xlsheet.Cells(i, 8) <> "" Then    'Excel表中第8列写了'完成'的更新到Access并在Excel中删除这一行
            res.Open "select * from 目录 where 编号='" & xlsheet.Cells(i, 1).Value & " '", con, 3, 3
            res.Fields("型号") = xlsheet.Cells(i, 2).Value
            res.Fields("类别") = xlsheet.Cells(i, 3).Value
            res.Fields("设计") = xlsheet.Cells(i, 4).Value
            res.Fields("下单时间") = xlsheet.Cells(i, 5).Value
            res.Fields("信息") = xlsheet.Cells(i, 9).Value
            res.Update
            res.Close
            xlsheet.Rows(CStr(i) & ":" & CStr(i)).Select
            Selection.ClearContents
        End If
    Next i
    xlsheet.Range("A2:M" & n).Sort key1:=xlsheet.Range("A2"), order1:=xlAscending
    xlbook.Save
    If res.State = adStateOpen Then res.Close
End FunctionPublic Function SToG(ByVal DAT As String) As ADODB.Recordset        '从数据库更新到工作表
    res.Open "select * from 目录", con, 1, 1
    If Not (res.EOF And res.BOF) Then
        res.MoveLast
        SystemSet.Progress.Min = 0
        SystemSet.Progress.Max = res.RecordCount
        SystemSet.Progress.Value = SystemSet.Progress.Min
        res.Close
    End If
    
    res.Open "select * from 目录", con, 1, 1
    i = xlsheet.Cells(1, 1).CurrentRegion.Rows.Count
    n = 0
    Do While Not res.EOF
        n = n + 1
        SystemSet.Progress.Value = n
        If IsNull(res.Fields("设计")) = True Then
            BH = res.Fields("编号")
            If i < 2 Then            '因为Exce表第一行是表头
                i = i + 1
                GoTo ad
            Else
                For B = 2 To i
                    If xlsheet.Cells(B, 1) = BH Then GoTo out
                Next B
ad:
                xlsheet.Cells(i, 1) = res.Fields("编号").Value
                xlsheet.Cells(i, 2) = res.Fields("型号").Value
                xlsheet.Cells(i, 3) = res.Fields("类别").Value
                xlsheet.Cells(i, 5) = res.Fields("下单时间").Value
                i = i + 1
            End If
        End If
out:
        res.MoveNext
    Loop
    xlbook.Close True
End FunctionFunction No(i) As String
js:
    B = i Mod 36
    If B > 9 Then B = Chr(B - 9 + 64)
    No = B & No
    i = Int(i / 36)
    If i > 0 Then GoTo js
End Function
目前CSV导入Access里时速度还可以，就是Access与Excel互相更新时速度有点慢，求大家能不能帮我改改？
本来想用数组或SQL查询语句来做，但我刚学还不知道怎么用。CSV导入到AccessAccess导入到ExcelExcel导入到Access

解决方案 »

  1.   

    数据库导入Excel切记不要一行一行写入Excel，非常慢，写excel本来就是com操作，一行一行写入最慢。excel可以绑定到数据库表的，你网上搜一下，很多数据库写入excel的例子。
      

  2.   

    我三表对应的是这样：
    CSV行一行：So，，，Item，，，，，，，Date，Note
    Access 字段：编号、型号、类别、设计、下单时间、信息
    Excel表头：编号、型号、类别、设计、下单时间、设计时间、校对时间、完成状态、信息
    Item对应‘型号’，Date对应‘下单时间’我是刚学，还有就是我这里面都不想用Data控件，请问一下我要怎么写呢？还不懂其他的语句
      

  3.   

    本帖最后由 bcrun 于 2013-03-30 16:32:58 编辑