0

既存の Access テーブルに新しいデータを追加するための以下のコードがあります。

約6000件のレコードをアップロードするのに約35〜40分かかります...

助けていただければ幸いです...

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

コードを高速化するための助けに感謝します。

今の速度では使えません。

ありがとう、g

4

1 に答える 1

3

3つの小さなヒント：

  • Accessにインデックスがある場合、追加/更新は予想よりも大幅に遅くなる可能性があります。データの追加中にこれらのインデックスを削除することをお勧めします。

  • 代わりにAccessでVBAを書いてみましたか？そうすれば、Excelファイルを一括でインポートし、必要なデータ操作を実行して、必要なテーブルに一度にロードできます（レコードごとではありません）。

  • 私のVBAは錆びているかもしれませんが、追加する新しいレコードごとにレコードセットを作成する必要はないと思います。サイクルの前に一度作成し、すべてのレコードが読み込まれるまで閉じないでください。

よろしく、

于 2012-09-17T12:50:39.987 に答える