Доступ к VBA Выберите Обновление записей подформы с помощью тега ввода

#vba #ms-access #dynamic-sql #recordset

Вопрос:

У меня есть основная форма, на которой есть кнопки, и объект подформы, установленный в динамическую инструкцию sql. Я настроил частный суб для on_exit объекта подформы, чтобы захватить 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
 

Затем я делаю 2 цикла через этот набор записей. Первый проверяет, что пользователь выбрал более 1 записи. Если они это сделали, я прошу их указать имя тега, чтобы я мог пометить выбранные записи пользовательским именем тега. Затем я снова просматриваю набор записей и для каждого элемента и выполняю инструкцию динамического обновления sql, чтобы обновить столбец тегов на основе идентификатора набора записей.

Это процедура, которая выполняется при нажатии командной кнопки на основной форме. Я помещаю комментарий, где происходит ошибка:

 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," amp; vbCrLf amp; _
                "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 = '" amp; TagListRecs amp; "' WHERE ID = " amp; 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 " amp; _
            "FROM XXX "
        fsql = fsql amp; "WHERE NZ(XXX.FIELD1,'') <> '' AND XXX.TAGCOL = '" amp; TagListRecs amp; "' "
        fsql = fsql amp; "ORDER BY XXX.FIELD1"
    
        Me.frmLists_SubResults.Form.RecordSource = fsql
        Me.frmLists_SubResults.Form.Requery
    
        Me.lblFilter.Caption = "List tagged for " amp; TagListRecs amp; ". Copy List to Excel and Have Fun!"
    End If
End Sub

 

Кто-нибудь может помочь?

Спасибо!

Ответ №1:

Вы этого не Set dbu делали до того, как попытались dbu.Execute … таким образом, это вызывает ошибку «Переменная объекта не установлена» (#91).

Добавьте строку с Set dbu = CurrentDb перед For y = 1 To mlngSelheight

Комментарии:

1. Вау. Я идиот, а ты гений! Спасибо!