使用输入标签访问 VBA Select 子表单记录更新
Access VBA Select SubForm Records Update with Input Tag
我有一个主窗体,上面有按钮,还有一个设置为动态 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
然后我对该记录集执行 2 个循环。第一个检查用户是否选择了多于 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, 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
有人能帮忙吗?
谢谢!
您在尝试 dbu.Execute
之前没有 Set dbu
... 因此会触发 “对象变量未设置” 错误 (#91)。
在For y = 1 To mlngSelheight
前加一行Set dbu = CurrentDb
我有一个主窗体,上面有按钮,还有一个设置为动态 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
然后我对该记录集执行 2 个循环。第一个检查用户是否选择了多于 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, 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
有人能帮忙吗?
谢谢!
您在尝试 dbu.Execute
之前没有 Set dbu
... 因此会触发 “对象变量未设置” 错误 (#91)。
在For y = 1 To mlngSelheight
Set dbu = CurrentDb