Object variable or With Block variable not set
I have this code that is executed upon pushing a button. After going through most of the code i get an error saying 'Object variable or With Block variable not set'.
Private Sub CancelJob_Click() On Error GoTo Err_Close_Jobs Dim BOM As String Dim i As Integer Dim strWhere As String Dim Index As Integer Dim rsSE As DAO.Recordset, OpenChanges As Long Dim MyUserName As String Dim RV2 As Variant Dim DB As DAO.Database Dim rs As DAO.Recordset Dim CancelledBy As Variant Dim EngInspDate As Variant Dim emailSubject As String Dim outApp As Outlook.Application Dim outMail As Outlook.MailItem Dim outStarted As Boolean
On Error Resume Next Set outApp = GetObject(, "Outlook.Application") On Error GoTo 0 If outApp Is Nothing Then Set outApp = CreateObject("Outlook.Application") outStarted = True End If
'MyComputerName = objNetwork.ComputerName Set DB = CurrentDb Set rs = DB.OpenRecordset("Orders", dbOpenDynaset, dbSeeChanges) Dim v As Variant For Each v In CheckItems If strWhere <> "" Then strWhere = strWhere & "','" strWhere = strWhere & v Debug.Print strWhere Next Dim strsql As String strsql = "SELECT * From ViewJob WHERE Cat IN (" & "'" & strWhere & "'" & ")" 'MsgBox ("You need to set the BOM Inspection value to yes before you can enter the hours worked on this job.") RV2 = MsgBox("Are you sure you want to cancel this job?", vbYesNo) If RV2 = vbYes Then
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset(strsql, dbOpenDynaset, dbSeeChanges)
Do While rst.EOF = False rst.Edit rst.Fields("EngBOMInspDate") = Now() rst.Fields("BOMInsp") = -1 rst.Fields("OrderStatus") = -1 ' DoCmd.Requery "OrderStatus" ' rst.Fields("OrdersStatus") = "Cancelled" rst.Update
CancelledBy = DLookup("FullName", "People", "WindowsUserName = " & "'" & TempVars!strUser & "'") Debug.Print CancelledBy Dim emailText As String Dim emailTo As String Dim emailTo1 As String Dim emailTo2 As String emailSubject = "JOB CANCELLED: " & rst.Fields("CustName") ' emailText = "LATE ENGINEERING COMMIT DATE" & vbCrLf & vbCrLf & "Project is past due it's commit date" & vbCrLf & vbCrLf emailText = "<strong>" & "<p style=color:darkblue;font-size:20px;>" & "JOB HAS BEEN CANCELLED" & "</p>" & "</strong>" & "<p>" & _ "THE FOLLOWING JOB HAS BEEN CANCELLED." & "</p>" _ & "<p>" & "" & "</p>" _ & "<strong>" & "<p>" & "<span style=color:darkblue;>" & "Cancelled By: " & "</span>" & "</strong>" & CancelledBy & "</p>" _ & "<strong>" & "<p>" & "<span style=color:darkblue;>" & "Engineer 1: " & "</span>" & "</strong>" & rst.Fields("1EngDetailer") & "</p>" _ & "<strong>" & "<p>" & "<span style=color:darkblue;>" & "Engineer 2: " & "</span>" & "</strong>" & rst.Fields("2EngDetailer") & "</p>" _ & "<strong>" & "<p>" & "<span style=color:darkblue;>" & "SO: " & "</span>" & "</strong>" & rst.Fields("Project") & "</p>" _ & "<strong>" & "<p>" & "<span style=color:darkblue;>" & "Line: " & "</span>" & "</strong>" & rst.Fields("Line") & "</p>" _ & "<strong>" & "<p>" & "<span style=color:darkblue;>" & "Design Commitment Date: " & "</span>" & "</strong>" & rst.Fields("DesBOMCommitDate") & "</p>" _ & "<strong>" & "<p>" & "<span style=color:darkblue;>" & "Require Release Date: " & "</span>" & "</strong>" & rst.Fields("ReqReleaseFromEngr") & "</p>" _ & "<strong>" & "<p>" & "<span style=color:darkblue;>" & "Customer: " & "</span>" & "</strong>" & rst.Fields("CustName") & "</p>" _ & "<strong>" & "<p>" & "<span style=color:darkblue;>" & "Description: " & "</span>" & "</strong>" & rst.Fields("Description") & "</p>" _ & "<strong>" & "<p>" & "<span style=color:darkblue;>" & "Customized Item: " & "</span>" & "</strong>" & rst.Fields("CustomizedItem") & "</p>" _ & vbCrLf & "" If IsNull(DLookup("EmailAddress", "People", "[FullName] = """ & rst.Fields("1EngDetailer") & """")) And IsNull(DLookup("EmailAddress", "People", "[FullName] = """ & rst.Fields("2EngDetailer") & """")) Then emailTo = ""
ElseIf IsNull(DLookup("EmailAddress", "People", "[FullName] = """ & rst.Fields("1EngDetailer") & """")) And Not IsNull(DLookup("EmailAddress", "People", "[FullName] = """ & rst.Fields("2EngDetailer") & """")) Then emailTo2 = DLookup("EmailAddress", "People", "[FullName] = """ & rst.Fields("2EngDetailer") & """") emailTo = emailTo2
ElseIf Not IsNull(DLookup("EmailAddress", "People", "[FullName] = """ & rst.Fields("1EngDetailer") & """")) And IsNull(DLookup("EmailAddress", "People", "[FullName] = """ & rst.Fields("2EngDetailer") & """")) Then emailTo1 = DLookup("EmailAddress", "People", "[FullName] = """ & rst.Fields("1EngDetailer") & """") emailTo = emailTo1 ElseIf Not IsNull(DLookup("EmailAddress", "People", "[FullName] = """ & rst.Fields("1EngDetailer") & """")) And Not IsNull(DLookup("EmailAddress", "People", "[FullName] = """ & rst.Fields("2EngDetailer") & """")) Then emailTo1 = DLookup("EmailAddress", "People", "[FullName] = """ & rst.Fields("1EngDetailer") & """") emailTo2 = DLookup("EmailAddress", "People", "[FullName] = """ & rst.Fields("2EngDetailer") & """") emailTo = emailTo1 & ";" & emailTo2 End If Debug.Print emailTo
Debug.Print emailText
Set outMail = outApp.CreateItem(olMailItem) outMail.To = emailTo outMail.Subject = emailSubject outMail.Importance = olImportanceHigh
' outMail.CC = "" outMail.HTMLBody = emailText outMail.Send
If outStarted Then outApp.Quit End If Set outMail = Nothing Set outApp = Nothing Set DB = Nothing ' now record a special event Set rsSE = CurrentDb.OpenRecordset("SpecialEvents", dbOpenDynaset, dbSeeChanges) rsSE.AddNew rsSE.Fields("Project") = rst.Fields("Project") rsSE.Fields("CustomizedItem") = rst.Fields("CustomizedItem") rsSE.Fields("DateRecordAdded") = Now() rsSE.Fields("OldDate") = Null rsSE.Fields("Comment") = InputBox("What is the reason for cancelling this job?", "Special Event Comments") rsSE.Fields("EventType") = "Job Cancelled" rsSE.Fields("ChangedBy") = TempVars!strUser rsSE.Update Set rsSE = Nothing rst.MoveNext Loop rst.Close Else ' this is being closed incorrecty Exit Sub End If
For Index = 1 To CheckItems.count CheckItems.Remove 1 Next DoCmd.Save Form.Requery Exit_Close_Jobs: Exit Sub Err_Close_Jobs: MsgBox Err.Number & "/" & Err.Description Resume Exit_Close_Jobs End Sub