PorscheMan
New member
- Local time
- Today, 14:02
- Joined
- Jan 16, 2013
- Messages
- 7
I have a form with a multi select list box set to Extended. On a command button, I have the following code. I am getting an error message stating Object variable or With block variable not set. What am I missing in the code below? Any help appreciated. Thanks
Code:
Private Sub Search_Click()
On Error GoTo Err_Search_Click
Dim varItem As Variant
Dim strWhere As String
Dim strWhere1 As String
Dim lngLen As Long
Dim strDelim As String
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim strSQL As String
Dim strSQL1 As String
With Me.lstMfg
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere1 = strWhere1 & "'" & strDelim & .ItemData(varItem) & strDelim & "',"
End If
Next varItem
End With
lngLen = Len(strWhere1) - 1
If lngLen > 0 Then strWhere1 = "[Make] IN (" & Left$(strWhere1, lngLen) & ") "
End If
strWhere = strWhere1
If Len(strWhere) > 0 And Len(strWhere1) > 0 Then strWhere = strWhere & " AND " & strWhere1Else strWhere = strWhere & strWhere1
End If
Set db = CurrentDb
'*** create the query based on the information on the form
strSQL = "SELECT qryByMake.* FROM qryByMake "
strSQL = strSQL & " WHERE " & strWhere
Set qdf = db.QueryDefs("qryByMake1")
qdf.SQL = strSQL
'*** open the query
strSQL1 = "SELECT qryByMake1.BaseVehicle, qryByMake1.BaseVehicleID, qryByMake1.PartID, qryByMake1.PartsDescription, qryByMake1.PartNumber, qryByMake1.Percar_Quantity, qryByMake1.Remarks1, qryByMake1.Remarks2, qryByMake1.Remarks3, qryByMake1.Class, qryByMake1.Line INTO [Missing Parts] " & vbCrLf & _"FROM qryByMake1 LEFT JOIN PartApplications ON (qryByMake1.PartID = PartApplications.PartID) AND (qryByMake1.BaseVehicleID = PartApplications.BaseID) " & vbCrLf & _"WHERE (((PartApplications.PartID) Is Null));"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL1
DoCmd.OpenTable "Missing Parts", acViewNormal, acEditDoCmd.
SetWarnings True
Exit_Search_Click:
Exit Sub
Err_Search_Click:
If Err.Number = 3265 Then '*** if the error is the query is missing Resume Next '*** then skip the delete line and resume on the next line Else MsgBox Err.Description '*** write out the error and exit the sub Resume Exit_Search_Click
End If
End Sub
Code:
Private Sub Search_Click()
On Error GoTo Err_Search_Click
Dim varItem As Variant
Dim strWhere As String
Dim strWhere1 As String
Dim lngLen As Long
Dim strDelim As String
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim strSQL As String
Dim strSQL1 As String
With Me.lstMfg
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere1 = strWhere1 & "'" & strDelim & .ItemData(varItem) & strDelim & "',"
End If
Next varItem
End With
lngLen = Len(strWhere1) - 1
If lngLen > 0 Then strWhere1 = "[Make] IN (" & Left$(strWhere1, lngLen) & ") "
End If
strWhere = strWhere1
If Len(strWhere) > 0 And Len(strWhere1) > 0 Then strWhere = strWhere & " AND " & strWhere1Else strWhere = strWhere & strWhere1
End If
Set db = CurrentDb
'*** create the query based on the information on the form
strSQL = "SELECT qryByMake.* FROM qryByMake "
strSQL = strSQL & " WHERE " & strWhere
Set qdf = db.QueryDefs("qryByMake1")
qdf.SQL = strSQL
'*** open the query
strSQL1 = "SELECT qryByMake1.BaseVehicle, qryByMake1.BaseVehicleID, qryByMake1.PartID, qryByMake1.PartsDescription, qryByMake1.PartNumber, qryByMake1.Percar_Quantity, qryByMake1.Remarks1, qryByMake1.Remarks2, qryByMake1.Remarks3, qryByMake1.Class, qryByMake1.Line INTO [Missing Parts] " & vbCrLf & _"FROM qryByMake1 LEFT JOIN PartApplications ON (qryByMake1.PartID = PartApplications.PartID) AND (qryByMake1.BaseVehicleID = PartApplications.BaseID) " & vbCrLf & _"WHERE (((PartApplications.PartID) Is Null));"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL1
DoCmd.OpenTable "Missing Parts", acViewNormal, acEditDoCmd.
SetWarnings True
Exit_Search_Click:
Exit Sub
Err_Search_Click:
If Err.Number = 3265 Then '*** if the error is the query is missing Resume Next '*** then skip the delete line and resume on the next line Else MsgBox Err.Description '*** write out the error and exit the sub Resume Exit_Search_Click
End If
End Sub
Last edited: