我有以下代码将新数据追加到现有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

感谢帮助加快代码的速度。

我无法以当前速度使用此功能。

谢谢,克

#1楼 票数:3

3个小技巧:

  • 如果您在Access中有索引,则添加/更新可能会比您预期的要慢得多。 您可能想在添加数据时删除这些索引。

  • 您是否尝试过在Access中编写VBA? 这样,您可以批量导入Excel文件,进行必要的数据处理,然后一次性将其加载到所需的表中(而不是逐条记录)。

  • 我的VBA可能会生锈,但是我认为您不必为要添加的新记录创建一个记录集。 在循环之前创建一次,直到将所有记录加载完毕才关闭它。

问候,

  ask by geebee translate from so

未解决问题?本站智能推荐:

1回复

上载Excel报表以通过VBA访问

什么? 我会根据资产类型以三种不同的格式接收Excel中的报告。 我正在尝试在Access中创建一个数据库,可以在其中基于某些条件进行添加和过滤。 至今.. 我想我应该制作一个主Excel文档,在其中可以通过宏过滤所需的数据,但是想知道是否有任何方法可以自动上载这些报告以在收到它们
1回复

使用VBA从Excel删除访问表单

我在Access数据库(Access 2007-10)中有2种表单,这些表单将记录馈入2个独立的表中。 我正在尝试在Excel工作簿中使用VBA删除这些表单。 我的Access数据库没有数据库密码,但是Access中的VBA项目有一个密码。 在Access数据库中,我创建了一个子过程(名为
2回复

访问VBa:在报告时检查excel文件的结尾

我正在将对访问表的某些检查结果写入excel文件。 有时结果超过65k,超出了excel可以处理的范围(excel 2002)。 我如何检查文件的末尾并打开新表以继续 谢谢
1回复

通过VBA从Excel进行SQL查询以访问(特定于日期)

为了进行测试,我试图使用vba和SQL(方向:Excel + VBA到Access)从MS Access表中获取一些数据到Excel中的记录集。 MS Access表称为T_Zeiten ,一列称为zeiDat ,其中包含日期(欧洲风格,如09.11.2016)。 我想做的是打开一个连接
1回复

访问VBA在Excel中拆分所有合并的单元格

我需要将一些Excel文件导入Access数据库。 我知道如何在VBA中编写导入功能,但是由于我在Excel中的某些合并单元格给我带来了麻烦,因此它无法按预期工作。 因此,例如,在Excel电子表格中 导入到Access表时,它逐行导入。 因此,第一行应为1-pencil-90,这是
1回复

使用更新按钮VBA从Access将信息填充到Excel

我正在尝试使用“更新”按钮从Access数据库查询到Excel电子表格中获取信息。 我发现一些代码应该可以运行,但是当我运行它时,它上面写着“运行错误'3061'。给定的参数太少,预期至少要有1个”。 这是代码: 当我调试时,它停在“ Set RS1”并说它是空的。 也许我什至没有与
1回复

访问excel2010查询以通过vba创建图表

经过广泛搜索后,我无法找到任何有关此内容的信息。 有很多例子,但这些都是访问权限2003,这些在访问2010中不起作用。 我需要运行一个vba代码,将查询结果(QryTotalSale)导出到excel 2010,并自动创建数据条形图并在正在运行的数据库上显示。 如果有人能给我一些建议
1回复

VBA代码从Excel循环和更新MSAccess数据库列

背景:我有一个Excel电子表格,可以从MS Access数据库中检索数据。 该代码工作正常。 它检索具有“注释”字段为空白的记录。 用户更新Excel中的注释字段,然后单击一个按钮。 询问:单击按钮后,VBA代码必须遍历我的excel工作表中的所有检索到的记录,并且那些在excel中