返回记录集中字段的索引

Question

我有一个由以下代码生成的记录集对象。

Private Sub GetID_Click()

'first find max id on sheet; used for if no ID is found on sheet
Dim myRange As Range
Dim maxIdOnSheet As Long
Dim clientSheet As Worksheet

Set clientSheet = Sheets("Client Codes")
Set myRange = clientSheet.Range("A1:A1048576")
maxIdOnSheet = WorksheetFunction.max(myRange) + 1

'set up connections with Nina's housing database
Dim cmd As New ADODB.Command
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strConn As String
Dim strSQL As String
Dim IDdb As Long
Dim IDwb As Long

'connection string
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\db\path\here\db.accdb; Persist Security Info=False"

'open connection database
conn.Open strConn

'sql statement
strSQL = "SELECT * FROM Clients WHERE (((Clients.FirstName)='" & FirstName.Value & "') AND ((Clients.LastName)='" & LastName.Value & "'));"

'open connection with the recordset
rs.Open strSQL, conn, adOpenDynamic, adLockOptimistic

'use the late-bound application match method to find out where the firstname and lastname values are in the worksheet, if found
Dim first As Long
Dim last As Long
Dim foundWB As Boolean
Dim foundDB As Boolean

foundWB = False
foundDB = False

Dim base As Long
Dim curRow As Long

base = 1

'First check to make sure if both values are in the worksheet
If Not IsError(Application.Match(FirstName.Value, Range("c" & base & ":c1048576"), False)) And Not IsError((Application.Match(LastName.Value, Range("b" & base & ":b1048576"), False))) Then
    'if it is in the worksheet, find where it is
    While found = False
        first = Application.Match(FirstName.Value, Range("c" & base & ":c1048576"), False)
        last = Application.Match(LastName.Value, Range("b" & base & ":b1048576"), False)
        If first = last Then
            foundWS = True
            curRow = curRow + first
            IDwb = Cells(curRow, 1)
        Else
            If first < last Then
                base = first + 1
                curRow = curRow + first
            ElseIf last < first Then
                base = last + 1
                curRow = curRow + last
            End If
        End If
    Wend
Else
    'if its not in the WS, it is now the highest +1
    IDwb = WorksheetFunction.max(Range("a1:a1048576")) + 1
End If

'find if its in the database
If rs.EOF Then
    'if its not in the database, find the highest number and add 1
    rs.Close
    strSQL = "SELECT MAX(Clients.[Client ID]) FROM Clients;"
    rs.Open strSQL, conn, adOpenDynamic, adLockOptimistic
    IDdb = rs.Fields(0) + 1
    MsgBox (rs.Properties.Item("Address"))
Else
    'if it is, find the first column
    IDdb = rs.Fields(0)
    foundDB = True
    MsgBox (rs.Properties.Item("Address"))
End If

If foundWB = True Then
    ClientID.Value = IDwb
ElseIf foundDB = True Then
    ClientID.Value = IDdb
Else
    If IDdb > IDwb Then
        ClientID.Value = IDdb
    ElseIf IDwb > IDdb Then
        ClientID.Value = IDwb
    Else
        ClientID.Value = IDwb
    End If
End If

End Sub

我有两个数据源 - 此宏位于 Excel 中的工作表和一个 Access 数据库。我输入客户数据，并为其分配特定代码。代码成功地做到了。

我还想根据收到的代码填写用户表单。上面的代码成功查询数据库，可以得到客户端ID。我还想要从查询中存储在数据库中的地址、城市、州、邮编、家庭收入等信息。

如果我在严格的 Excel 中执行此操作，我将使用 match 语句，如果严格通过 Access，则使用 SQL 查询。我正在尝试同时在 Excel 工作表和 Access 数据库上运行此查询，或者在相同的代码中运行此查询。这需要设置一个记录集对象：文档位于此处 http://www.w3schools.com/asp/ado_ref_recordset.asp 和这里 https://msdn.microsoft.com/en-us/library/ms675841(v=vs.85).aspx.

我知道我可以通过类似的方式获取信息

name = rs.fields(1)
address = rs.fields(4)
city = rs.fields(5)
'...

我宁愿动态获取索引。如果人们更改数据库，我希望公式稳定。

假设“地址”字段是否可以是索引 4、5、6、7，直到任何时候。

如何动态查找记录集对象中特定字段的索引？

Answer 1

那么，如何在记录集对象中动态查找特定字段的索引？假设“地址”字段是否可以是索引 4、5、6、7，直到任何时候。

ADO 记录集中没有直接的属性来获取它，但您可以通过循环遍历字段并像我在此函数中一样保持计数来找到它：

Public Function GetRecordsetFieldIndexFromName(rs As adodb.Recordset, ColumnName As String) As Variant
' Pass in an ADODB recordset and a column name and return the column index.
' Returns index in base 0.
' Ben S. - 11/8/2019

    On Error GoTo ErrorHandler

    Dim i As Long

    If rs Is Nothing Then
        ' Recordset is not loaded
    Else
        For i = 0 To rs.Fields.count - 1
            'Debug.Print i, rs.Fields(i).Name
            If rs.Fields(i).Name = ColumnName Then
                GetRecordsetFieldIndexFromName = i
                Exit For
            End If
        Next
    End If

Exit_Function:
    Exit Function

ErrorHandler:
    MsgBox "Error #" & err.Number & " - " & err.Description & vbCrLf & "in procedure GetRecordsetFieldIndexFromName"
    GoTo Exit_Function
    Resume Next
    Resume
End Function

这是一个您可以在 Access 中尝试的简单测试。

Public Sub TestADOrs()
' BS 11/8/2019 - Test for GetRecordsetFieldIndexFromName

    Dim i           As Long
    Dim strSQL      As String
    Dim conn        As New adodb.Connection
    Dim rs          As New adodb.Recordset

    ' Set an object pointing to the current database connection
    Set conn = CurrentProject.Connection
    strSQL = "Select Top 1 * From MSysObjects"
    rs.Open strSQL, conn, adOpenStatic, adLockOptimistic

    Debug.Print GetRecordsetFieldIndexFromName(rs, "Flags") ' This should return 4

    Set rs = Nothing
    Set conn = Nothing

End Sub

我用列表框和组合框控件制作了与此类似的功能。它们将允许您通过传递控件和列/字段名称从控件返回索引或值。
https://stackoverflow.com/a/58773219/1898524 - Reference List Box Column by Field Name