将Excel工作表范围导入到MS Access表

Question

下午好，

我创建了一个宏，该宏将数据上传到访问数据库（均在我的桌面上）。 问题是尝试扩大范围时，我总是收到错误消息。

我以为这很简单，但似乎是我忽略的事情。

这是代码-基本上我想包括该列或将其设置为动态范围？ 你能帮忙吗？

Sub AccessCode()

    Application.ScreenUpdating = False

    Dim db As Database
    Dim rs As DAO.Recordset

    Set db = OpenDatabase("C:\Users\user\Desktop\Test Copy.accdb")
    Set rs = db.OpenRecordset("Fact Table", dbOpenTable)

    rs.AddNew
    rs.Fields("GUID") = Range("g2").Value
    rs.Fields("StageID") = Range("h2").Value
    rs.Fields("Sync Date") = Range("i2").Value
    rs.Fields("Forecast HP") = Range("j2").Value
    rs.Fields("Owner Id") = Range("k2").Value
    rs.Fields("Recent Modified Flag") = Range("L2").Value
    rs.Fields("Upload Date") = Range("M2").Value

    rs.Update
    rs.Close
    db.Close

    Application.ScreenUpdating = True
    MsgBox " Upload To PMO Database Successful."

End Sub

Answer 1

您可以使用查询而不是遍历记录集：

Sub AccessCode()
    Application.ScreenUpdating = False
    Dim db As Database
    Dim rs As DAO.Recordset

    Set db = OpenDatabase("C:\Users\user\Desktop\Test Copy.accdb")
    db.Execute "INSERT INTO [Fact Table] ([GUID], [StageID], etc) " & _
    "SELECT * FROM [SheetName$G:M] " & _
    "IN """ & ActiveWorkbook.FullName & """'Excel 12.0 Macro;HDR=No;'"
End Sub

这具有许多优点，例如通常更快，因为您不必遍历所有字段。

如果要从Access而不是Excel触发导入，则甚至不需要VBA来执行查询。

Answer 2

将rs部分更改为此：

With rs
    .addnew
    !GUID = Range("g2").Value
    !StageID = Range("h2").Value
    '...etc
    .Update
End With

MSDN源码

使用AddNew方法在记录集命名的Recordset对象中创建并添加新记录。 此方法将字段设置为默认值，如果未指定默认值，则将字段设置为Null（为表类型Recordset指定的默认值）。

修改新记录后，使用Update方法保存更改并将记录添加到Recordset。 在使用Update方法之前，数据库中不会发生任何更改。

编辑：当您使用上面的代码更改rs部分时，这就是代码的外观：

Sub AccessCode()

    Application.ScreenUpdating = False

    Dim db As Database
    Dim rs As DAO.Recordset

    Set db = OpenDatabase("C:\Users\user\Desktop\Test Copy.accdb")
    Set rs = db.OpenRecordset("Fact Table", dbOpenTable)

    With rs
        .addnew
        !GUID = Range("g2").Value
        !StageID = Range("h2").Value
        '...etc
        .Update
        .Close
    End With

    Application.ScreenUpdating = True
    MsgBox " Upload To PMO Database Successful."

End Sub

Answer 3

只是以为我会补充@Erik von Asmuth的出色答案。 我在一个真实的项目中使用了类似的东西。 导入动态范围的功能更强大。

Public Sub ImportFromWorksheet(sht As Worksheet)

    Dim strFile As String, strCon As String

    strFile = sht.Parent.FullName

    strCon = "Excel 12.0;HDR=Yes;Database=" & strFile

    Dim strSql As String, sqlTransferFromExcel As String

    Dim row As Long
    row = sht.Range("A3").End(xlDown).row
    Dim rng As Range

    sqlTransferFromExcel = " Insert into YourTable( " & _
                " [GUID] " & _
                " ,StageID " & _
                " ,[sync Date] " & _
                " ,[etc...] " & _
                " ) " & _
                " SELECT [GUID] " & _
                " ,StageID " & _
                " ,[sync Date] " & _
                 " ,[etc...] " & _
                " FROM [{{connString}}].[{{sheetName}}$G2:M{{lastRow}}]"

    sqlTransferFromExcel = Replace(sqlTransferFromExcel, "{{lastRow}}", row)
    sqlTransferFromExcel = Replace(sqlTransferFromExcel, "{{connString}}", strCon)
    sqlTransferFromExcel = Replace(sqlTransferFromExcel, "{{sheetName}}", sht.Name)

    CurrentDb.Execute sqlTransferFromExcel

End Sub