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 " & strWhere1
Else
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, acEdit
DoCmd.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