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未绑定，否则我会通过InputBox使用CommandButton：

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

注意这是未经测试的，我刚从内存中写出来，但它应该让你走在正确的轨道上。

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

1 个答案: