使用 VBA 的 Access 2007 表单中的字段匹配循环

Question

我有一个包含多个数据输入框（文本、组合、复选框和选项组）的表单。数据输入框的名称与将要附加/提取数据的相应表的字段名称相匹配。

在此示例中，当用户从组合框中选择一个值时，将执行一个 sql 来收集符合条件的数据并自动填充表单中的一堆字段。我的真实表单中有很多字段，我将在整个过程中运行类似的功能（例如，将数据写入不同的表（table3）），我想创建一个循环来执行字段匹配，而不是列出每个表单数据输入框等于它对应的记录源。

使用这个测试示例，我怎样才能将我的脚本改为循环：

Private Sub txt_ID_AfterUpdate()

Dim db As Database
Dim rs As DAO.Recordset
Dim strSQL As String

    strSQL = "SELECT Table1.ID, Table1.Color, Table1.Make, Table1.Model, Table2.FName, Table2.LName FROM Table1 INNER JOIN Table2 ON Table1.ID = Table2.ID WHERE"
    strSQL = strSQL & "[Table1].ID = """ & Me.txt_ID & """"

    Set rs = Currentdb.OpenRecordset(strSQL, DB_OPEN_DYNASET)

    Me!ID = rs!ID
    Me!Color = rs!Color
    Me!Make = rs!Make
    Me!Model = rs!Model
    Me!FName = rs!FName
    Me!LName = rs!LName

    rs.Close
    Set rs = Nothing

我希望它做这样的事情：

Private Sub txt_ID_AfterUpdate()

Dim db As Database
Dim rs As DAO.Recordset
Dim strSQL As String

    strSQL = "SELECT Table1.ID, Table1.Color, Table1.Make, Table1.Model, Table2.FName, Table2.LName FROM Table1 INNER JOIN Table2 ON Table1.ID = Table2.ID WHERE"
    strSQL = strSQL & "[Table1].ID = """ & Me.txt_ID & """"

    Set rs = Currentdb.OpenRecordset(strSQL, DB_OPEN_DYNASET)
    For each Name in FormA
        Me!<Name> = rs!<Name>
    Next Name

    rs.Close
    Set rs = Nothing

非常感谢。

最终的脚本看起来像这样。 Simon1979 脚本也有效。

Private Sub txt_ID_AfterUpdate()

Dim db As Database
Dim rs As DAO.Recordset
Dim strSQL As String

    strSQL = "SELECT Table1.ID, Table1.Color, Table1.Make, Table1.Model, Table2.FName, Table2.LName FROM Table1 INNER JOIN Table2 ON Table1.ID = Table2.ID WHERE"
    strSQL = strSQL & "[Table1].ID = """ & Me.txt_ID & """"

    Set rs = Currentdb.OpenRecordset(strSQL, DB_OPEN_DYNASET)

    rs.MoveFirst
    For Each fld In rs.Fields
        Me.Controls(fld.Name) = fld
    Next fld

    rs.Close
    Set rs = Nothing

End Sub

Answer 1

[我的建议和对您问题的回答，选择适合您需要的]

将表单绑定但编辑RecordSource 以使表单成为您的strSQL 是否会更好？为编辑数据增加了更多范围/轻松，我假设您打算通过使用 DB_OPEN_DYNASET 来做到这一点，尽管您当前的方法不会将数据锁定在 rs.Close 之外。

此方法需要另一种收集ID 的方法，除非txt_ID 未绑定，否则我将通过CommandButton 使用InputBox：

Sub cmdRetrieveRecord()

Dim strSQL as String, strID as string

EnterID:
    strID = InputBox("Enter the required ID:")
    If StrPtr(strID) = 0 Then 'Cancel was pressed
        ExitSub
    ElseIf Len(strID) = 0 Then 'OK was pressed with nothing entered
        MsgBox "You must enter an ID."
        GoTo EnterID
    End If
    If Not IsNumeric(strID) Then
        MsgBox "You must enter only a numeric ID"
        GoTo EnterID
    End If

    strSQL = "SELECT Table1.ID, Table1.Color, Table1.Make, Table1.Model, Table2.FName, " _
        & "Table2.LName FROM Table1 INNER JOIN Table2 ON Table1.ID = Table2.ID WHERE"
    strSQL = strSQL & "[Table1].ID = """ & strID & """"

    Me.RecordSource = strSQL

End Sub

注意如果输入的 ID 没有记录，则表单将为空白，请确保将 cmdRetrieveRecord 按钮放在表单页眉或页脚中，以便它仍然可见，或者处理您的代码中存在这种情况。

然后您可以从表单属性控制数据是否为Snapshot/Dynaset、可编辑等。

如果您希望继续使用您的预期方法，我认为您应该能够通过迭代记录集的 Fields 属性来执行以下操作，尽管您必须非常小心地命名字段和控制，我想它迟早会绊倒你。

Dim x As Integer

Set rs = Currentdb.OpenRecordset(strSQL, DB_OPEN_DYNASET)
If rs.EOF And rs.BOF Then 
    ' No record for this ID, handle accordingly and ExitSub
End If
rs.MoveFirst
For x = 0 To rs.Fields.Count - 1
    Me.Controls(rs(x).Name) = rs(x)
Next x

注意这是未经测试的，我只是凭记忆写的，但它应该能让你走上正轨。