VBA 将 DAO 连接字符串和 Recordset 转换为 ODBC

Question

我有一个用 VBA 在 Word 中编写的加载项，它相当旧。我认为它可以追溯到 1997 年。目前 VBA 代码将连接到 Access 2003 数据库并查询 table 和 return 数据记录集并从中生成供应商列表table查询。

下面是使用DAO方法的代码。现在的问题是我们收到的具有 windows 10 的较新计算机没有 DAO 方法可以使用的旧库。（加上 DAO 本身又旧又过时）。

Public strData() As String

Sub GetData(strTable As String)
Dim dbf As DAO.Database
Dim rst As DAO.Recordset
Dim Counter As Long
Dim strCriteria As String


If strTable = "VendorQ" Then
    strCriteria = "SELECT NameSort FROM Vendor Where Qualified = -1 ORDER BY NameSort"
ElseIf strTable = "VendorU" Then
    strCriteria = "SELECT NameSort FROM Vendor Where Qualified = 0 ORDER BY NameSort"
ElseIf strTable = "MainR" Then
    strCriteria = "SELECT NameSort FROM Vendor ORDER BY NameSort"
Else
    MsgBox "Error"
End If

Set dbf = OpenDatabase("\fileLocation\center.mdb")
Set rst = dbf.OpenRecordset(strCriteria)

frmCenter.MousePointer = fmMousePointerHourGlass
Counter = 0
If rst.RecordCount > 0 Then
    rst.MoveLast

    ReDim strData(rst.RecordCount - 1) As String
    rst.MoveFirst
    Do Until rst.EOF
        strData(Counter) = rst![NameSort]
        Counter = Counter + 1
        rst.MoveNext
    Loop
Else
    ReDim strData(0)
End If
frmCenter.MousePointer = fmMousePointerArrow
rst.Close
End Sub

这将 return 一个列表：

table 已经存在于 MySQL 数据库中，因此我可以使用 ODBC 连接来检索数据，而不是将 Access 作为链接 table 的传递。我尝试转换连接字符串并连接到数据库，但由于某种原因没有显示供应商列表。

转换后的代码如下：

Public strData() As String

Sub GetData(strTable As String)
Dim rst As ADODB.Recordset
Dim Counter As Long
Dim strCriteria As String
Dim conn As ADODB.Connection

Set remoteCon = New ADODB.Connection

conStr = "DRIVER={MySQL ODBC 5.2 ANSI Driver};" & _
    "SERVER=server;DATABASE=database;" & _
    "UID=uid;PWD=pwd"
    
remoteCon.ConnectionString = conStr
remoteCon.Open

remoteCon.Execute ("USE database;")

Set rst = New ADODB.Recordset

If strTable = "VendorQ" Then
    strCriteria = "SELECT NameSort FROM Vendor Where Qualified = -1 ORDER BY NameSort"
ElseIf strTable = "VendorU" Then
    strCriteria = "SELECT NameSort FROM Vendor Where Qualified = 0 ORDER BY NameSort"
ElseIf strTable = "MainR" Then
    strCriteria = "SELECT NameSort FROM Main ORDER BY NameSort"
Else
    MsgBox "Error"
End If

With rst
    .ActiveConnection = remoteCon
    .CursorType = adOpenDynamic
    .LockType = adLockOptimistic
    .Source = strCriteria
    .Open
End With

frmCenter.MousePointer = fmMousePointerHourGlass
Counter = 0
If rst.RecordCount > 0 Then
    rst.MoveLast

    ReDim strData(rst.RecordCount - 1) As String
    rst.MoveFirst
    Do Until rst.EOF
        strData(Counter) = rst![NameSort]
        Counter = Counter + 1
        rst.MoveNext
    Loop
Else
    ReDim strData(0)
End If
frmCenter.MousePointer = fmMousePointerArrow
rst.Close
End Sub

是否有不同的方法从 ODBC 源填充记录集？

Answer 1

RecordCount 通常是不可靠的，直到你运行记录集结束（例如在 MoveLast 中）所以我会使用 EOF 检查：

If Not rst.EOF Then
    rst.MoveLast
    ReDim strData(rst.RecordCount - 1) As String
    rst.MoveFirst
    Do Until rst.EOF
        strData(Counter) = rst![NameSort]
        Counter = Counter + 1
        rst.MoveNext
    Loop
Else
    ReDim strData(0)
End If

编辑：

仅供参考，在我的测试中，RecordCount 使用 adOpenDynamic 始终为 -1，但我使用 adOpenKeyset

获得了正确的值

如果 RecordCount 不可靠，那么您可以使用 GetRows() 将记录传输到二维数组，然后使用它来调整大小并填充 strData

If Not rs.EOF Then
    arrRecs = rs.GetRows 'a 2D array (0 to #cols-1, 0 to #rows-1)
    ReDim strData(UBound(arrRecs, 2))
    For i = 0 To UBound(arrRecs, 2)
        strData(i) = arrRecs(0, i)
    Next i
Else
    ReDim strData(0)
End If

Answer 2

请参阅 Erik A 的回答将 .CursorLocation = adUseClient 添加到第一个打开的字符串解决了这个问题。

VBA 将 DAO 连接字符串和 Recordset 转换为 ODBC

VBA convert DAO connection string and Recordset to ODBC

odbc

vba

ms-word