Object variable or With Block variable not set

Lopez, Ahiezer 236 Reputation points
2024-06-18T16:01:14.43+00:00

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'.

User's image User's image

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

Access
Access
A family of Microsoft relational database management systems designed for ease of use.
332 questions
Access Development
Access Development
Access: A family of Microsoft relational database management systems designed for ease of use.Development: The process of researching, productizing, and refining new or existing technologies.
848 questions
{count} votes