Question

我有一个Excel VBA宏，它将在2010年更新MDB记录的特定字段值。

我刚刚更新到Excel16，并且我得到了ActiveX组件无法使用一次功能代码创建对象错误。

在Set Db = OpenDatabase(MDBPath)上出现错误

这是完整的代码：

Sub UpdateAccess()

MDBPath = Sheets("Setup").Range("E19").Value
TabName = Sheets("Setup").Range("E20").Value

Set Db = OpenDatabase(MDBPath)
Set rs = Db.OpenRecordset(TabName, dbOpenTable)

With Sheets("Batches")
    lRow = .Cells(Rows.Count, 1).End(xlUp).Row
End With

BatchNameColumn = Sheets("references").Range("G22").Value
BatchDEColumn = Sheets("references").Range("G28").Value

i = 1

Do While i < lRow

    i = i + 1

    BatchName = Sheets("BatchesForLabels").Range(BatchNameColumn & i).Value

    With rs
        rs.MoveFirst
        While Not rs.EOF
            If rs.Fields("Name").Value = BatchName Then
                rs.Edit
                rs.Fields("ActualDE").Value = Round(Sheets("BatchesForLabels").Range(BatchDEColumn & i).Value, 2)
                rs.Update
                rs.MoveNext
            Else:
                rs.MoveNext
            End If
        Wend
    End With

Loop

rs.Close
Set rs = Nothing
Db.Close
Set Db = Nothing

这是我启用的参考

Visual Basic For Applications
Microsoft Excel 16.0 Object Library
OLE Automation
Microsoft Office 16.0 Object Library
Microsoft ADO Ext. 2.8 for DDL and Security
Microsoft ActiveX Data Objects 2.8 Library
Microsoft Windows Common Controls - 26.0 (sp6)
Microsoft Forms 2.0 Object Library
Microsoft DAO 3.6 Object Library

这是参考图书馆问题，还是在这种新环境中需要采取其他策略来更新MDB记录？

这是一个工作场所应用程序，我目前无法完全控制各种安装件

Answer 1

Sub UpdateAccess()

    Dim oConn As Object
    Dim rs As Object
    Dim sConn As String
    Dim s As String

    MDBPath = Sheets("Setup").Range("E19").Value
    TabName = Sheets("Setup").Range("E20").Value

    s = MDBPath
    sConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & s 'Access 2010

    Set oConn = CreateObject("ADODB.Connection")
    oConn.Open sConn

    Set rs = CreateObject("ADODB.RecordSet")
    rs.Open TabName, oConn, 1, 3, &H2

    With Sheets("Batches")
        lRow = .Cells(Rows.Count, 1).End(xlUp).Row
    End With

    BatchNameColumn = Sheets("references").Range("G22").Value
    BatchDEColumn = Sheets("references").Range("G28").Value

    i = 1

    Do While i < lRow

        i = i + 1

        BatchName = Sheets("BatchesForLabels").Range(BatchNameColumn & i).Value

        With rs
            rs.MoveFirst
            While Not rs.EOF
                If rs.Fields("Name").Value = BatchName Then
                    'rs.Edit
                    rs.Fields("ActualDE").Value = Round(Sheets("BatchesForLabels").Range(BatchDEColumn & i).Value, 2)
                    rs.Update
                    rs.MoveNext
                Else:
                    rs.MoveNext
                End If
            Wend
        End With

    Loop

    rs.Close
    Set rs = Nothing
    oConn.Close
    Set oConn = Nothing
End Sub

添加了dim语句，并更改为oledb 12.0。该代码适用于我的目的。必须删除rs.edit，以便将来引用此内容的任何人

使用Excel 16更新MDB记录-ActiveX组件无法创建对象

1 个答案: