使用输入标签访问 VBA 选择子表单记录更新

问题描述

我有一个带有按钮的主窗体，以及一个设置为动态 sql 语句的子窗体对象。我为subform对象的on_exit设置了一个private sub来抓取seltop和selheight。

Private mlngSelTop As Long
Private mlngSelheight As Long

Private Sub frmlists_SubResults_Exit(Cancel As Integer)
    'GRAB FirsT AND LAST SELECTED RECORDS
    mlngSelTop = Me.frmlists_SubResults.Form.SelTop
    mlngSelheight = Me.frmlists_SubResults.Form.SelHeight
End Sub

然后我循环遍历那个记录集。第一个检查用户是否选择了超过 1 条记录。如果他们这样做了，我会要求他们提供标签名称，以便我可以使用自定义标签名称来标记所选记录。然后我再次遍历记录集，并针对每个项目执行动态 sql 更新语句以根据记录集 ID 更新标记列。

这是例程，在主窗体上单击命令按钮时运行。我在错误发生的地方发表了评论：

Private Sub cmdTagList_Click()
    Dim Message,Title,Default,TagListRecs
    Dim w As Long
    Dim x As Long
    Dim y As Long
    Dim F As Form
    Dim db As DAO.Database
    Dim RS As DAO.Recordset
    Dim dbu As DAO.Database
    Dim RSu As DAO.Recordset
    Dim usql As String
    Dim fsql As String
    
    Set F = Me.frmlists_SubResults.Form
    Set RS = F.RecordsetClone
    
    ' Move to the first record in the recordset.
    RS.MoveFirst
    
    ' Move to the first selected record.
    RS.Move mlngSelTop - 1
    
    'LOOP THROUGH SUBFORM RECORDSET FROM SELTOP TO SELHEIGHT AND BUILD COUNT
    
    w = 0
    For x = 1 To mlngSelheight
        w = w + 1
        RS.MoveNext
    Next x
    RS.Close
    Set RS = nothing
    Set db = nothing
    
    'CHECK COUNT OF SELECTED RECORDS
    If w < 2 Then
        MsgBox "Please select records from the subform,by selecting 1 record on the left of the row," & vbCrLf & _
                "press the shift key and select the last record to be tagged.",vbCritical,"Must Select Records to Tag"
    
    'MULTIPLE RECORDS WERE SELECTED - DO UPDATES
    Else
        Message = "Please Provide Tag Name:"  ' Set prompt.
        Title = "Provide List Name"    ' Set title.
        Default = "0"    ' Set default..
        TagListRecs = InputBox(Message,Default)
        Set RSu = F.RecordsetClone
    
        RSu.MoveFirst
    
        ' Move to the first selected record.
        RSu.Move mlngSelTop - 1
        'CYCLE THROUGH RECORDSET AND RUN UPDATE sql TO TAG RECORDS SELECTED WITH THE TAG NAME PROVIDED
        For y = 1 To mlngSelheight
     
            usql = "UPDATE tblVFileImport SET CallSheet = '" & TagListRecs & "' WHERE ID = " & RSu![ID]
    
        'THIS IS THE LINE THAT ERRORS - RUN-TIME ERROR 91
            dbu.Execute usql,dbFailOnError
        'THIS IS THE LINE THAT ERRORS - RUN-TIME ERROR 91
        RSu.MoveNext
        Next y
    
        RSu.Close
    
        Set RSu = nothing
        Set dbu = nothing
    
        fsql = "SELECT XXX.FIELDS " & _
            "FROM XXX "
        fsql = fsql & "WHERE NZ(XXX.FIELD1,'') <> '' AND XXX.TAGCOL = '" & TagListRecs & "' "
        fsql = fsql & "ORDER BY XXX.FIELD1"
    
        Me.frmlists_SubResults.Form.RecordSource = fsql
        Me.frmlists_SubResults.Form.Requery
    
        Me.lblFilter.Caption = "List tagged for " & TagListRecs & ". copy List to Excel and Have Fun!"
    End If
End Sub

有人可以帮忙吗？

谢谢！

解决方法

您在尝试 Set dbu 之前没有 dbu.Execute ...因此触发了“未设置对象变量” 错误 (#91)。

在 Set dbu = CurrentDb 前添加一行 For y = 1 To mlngSelheight