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 source

使用AddNew方法在Recordset命名的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

将Excel工作表范围导入Ms Access Table

3 个答案: