如何从具有相同架构的Excel电子表格中添加或插入记录到Access表中?

时间:2019-04-11 20:24:44

标签: vba ms-access access-vba ado

我想基于具有相同精确模式的Excel电子表格的值来将记录更新或插入到Access表中。我已经使用ADO连接到Excel电子表格,并将数据加载到记录集中。我还编写了简单的代码来更新Access中的表或在主键不存在的情况下插入记录。但是对于具有多列的表,这很快变得不切实际,难道没有更简单的代码可以做到吗?

Sub Test()
    On Error Resume Next

    Const adOpenStatic = 3
    Const adLockOptimistic = 3
    Const adCmdText = &H1

    Set objConnection = CreateObject("ADODB.Connection")
    Set objRecordset = CreateObject("ADODB.Recordset")

    objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=C:\Users\me\Downloads\Test.xlsx;" & _
            "Extended Properties=""Excel 8.0;HDR=Yes;"";"

    objRecordset.Open "Select * FROM [Sheet1$]", _
        objConnection, adOpenStatic, adLockOptimistic, adCmdText

    Do Until objRecordset.EOF
        DoCmd.RunSQL "UPDATE Test SET [LastName]='" & objRecordset.Fields.Item("LastName") & "' WHERE [PhoneNbr] = " & objRecordset.Fields.Item("PhoneNbr")
        DoCmd.RunSQL "INSERT INTO Test ([PhoneNbr], [LastName]) VALUES(" & objRecordset.Fields.Item("PhoneNbr") & "'" & objRecordset.Fields.Item("LastName") & "') WHERE " & objRecordset.Fields.Item("PhoneNbr") & " NOT IN ( SELECT PhoneNbr FROM Test )"
        objRecordset.MoveNext
    Loop
End Sub

0 个答案:

没有答案