将 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

只是想我会添加一个替代@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

Answer 2

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

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 3

将rs 部分更改为此：

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

MSDN source

使用 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