VBA convert DAO connection string and Recordset to ODBC - vba

Question

I have an add-in that's written in VBA in Word that is rather old. I think it dates back to 1997. Currently the VBA code will connect to an Access 2003 database and query a table and return a recordset of the data and generate a list of vendors from that table query.
Below is the code that uses the DAO method. The problem now is the newer computers that we are receiving that have windows 10 do not have the older libraries that the DAO method works with. (Plus DAO itself is old and outdated).
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
This will return a list:
The table already exists in a MySQL database so I could use an ODBC connection to retrieve the data and not mess with Access as a pass thru to a linked table. I tried converting the connection string and it connects to the database but for some reason doesn't show the list of vendors.
Here is the converted code:
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
Is there a different way to populate the recordset from an ODBC source?

Answer 1

RecordCount is often unreliable until after you've run to the end of the recordset (as in MoveLast for example) so I'd use a check on EOF instead:
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
EDIT:
FYI in my tests RecordCount was always -1 using adOpenDynamic but I got the correct value with adOpenKeyset
If RecordCount is not reliable then you can use GetRows() to transfer the records to a 2D array, then use that to resize and populate 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

Please see this answer by Erik A https://stackoverflow.com/a/46130089/2359206
Adding .CursorLocation = adUseClient to the rst open string solved the issue.