简体   繁体   中英

Access VBA Select SubForm Records Update with Input Tag

I have a main form that has buttons on it, and a subform object set to a dynamic sql statement. I set up a private sub for the on_exit of the subform object to grab the seltop and 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

Then I do 2 cycles through that recordset. The first checks that the user selected more that 1 record. If they did, I ask them to provide a tag name, so I can tag the selected records with a custom tag name. I then loop through the recordset again, and for each item, and execute a dynamic sql update statement to update the tag column based on the recordset ID.

This is the routine, which runs on command button click on the main form. I put a comment where the error happens:

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, Title, 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

Can anyone help?

Thanks!

You didn't Set dbu before attempting dbu.Execute ... so that triggers the "Object variable not set" error (#91).

Add a line with Set dbu = CurrentDb before For y = 1 To mlngSelheight

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM