0

I've been working on the below code for days, hopefully the end product will do 2 things.

Send an email to a team organizer with details from the spreadsheet. Send an outlook appointment to the desk assessor with the appointment details.

I get an error message saying:

Compile Error:

End if without block if

Sub ACarr_Step2()
    Dim iRet As Integer
    Dim strPrompt As String
    Dim strTitle As String

    ' Promt
    strPrompt = "Have you checked if Joe Bloggs is available?"

    ' Dialog's Title
    strTitle = "Availability Confirmation"

    'Display MessageBox
    iRet = MsgBox(strPrompt, vbYesNo, strTitle)

    ' Check pressed button
    If iRet = vbNo Then
        MsgBox "Please check Availability with Joe Bloggs"
    Else
          Dim OutApp As Object
    Dim OutMail As Object

    assessor = Sheets("ACarr").Range("AB5").Text
    clerk = Sheets("ACarr").Range("AB1").Text
    team = Sheets("ACarr").Range("AB2").Text
    datee = Sheets("ACarr").Range("AB3").Text
    timeslot = Sheets("ACarr").Range("AB4").Text

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = "Team.organizer@company.co.uk"
        .CC = ""
        .BCC = ""
        .Subject = "DSE Assessment Booking"
        .Body = "Hi there," & vbNewLine & vbNewLine & "Could you please arrange for the agents below to be rota'd off to complete a Desk Assessment." & vbNewLine & vbNewLine & "Assessor: " & assessor & vbNewLine & "Staff Member : " & clerk & vbNewLine & "Team: " & team & vbNewLine & "Date: " & datee & vbNewLine & "Time Slot: " & timeslot & vbNewLine & vbNewLine & "Thank You"

        .send

' Create the Outlook session
Set myoutlook = CreateObject("Outlook.Application")
' Create the AppointmentItem
Set myapt = myoutlook.CreateItem(olAppointmentItem)     ' Set the appointment properties
With myapt
    .Subject = "DSE Assessment Booking"
    .Location = Sheets("ACarr").Range("AB2").Text
    .Start = Sheets("ACarr").Range("AB4").Text
    .Duration = 30
    .Recipients = "Desk.Assessor@Company.co.uk"
    .MeetingStatus = olMeeting
    ' not necessary if recipients are email addresses
    'myapt.Recipients.ResolveAll
    .AllDayEvent = "False"
    .BusyStatus = "2"
    .ReminderSet = False
    .Body = "Hi there," & vbNewLine & vbNewLine & "Could you please arrange for the agents below to be rota'd off to complete a Desk Assessment." & vbNewLine & vbNewLine & "Assessor: " & assessor & vbNewLine & "Staff Member : " & clerk & vbNewLine & "Team: " & team & vbNewLine & "Date: " & datee & vbNewLine & "Time Slot: " & timeslot & vbNewLine & vbNewLine & "Thank You"
        .Save
    .send

        Application.ScreenUpdating = False
    Sheets("ACarr").Activate
    Range("C14").Select
    Selection.ClearContents
    Range("C20").Select
    Selection.ClearContents
    Range("C26").Select
    Selection.ClearContents
    Range("C32").Select
    Selection.ClearContents
    Sheets("Menu").Activate
    'enable the application to show screen switching again
    Application.ScreenUpdating = True

    ActiveWorkbook.Save

    MsgBox "Your Email has been sent and changes saved."

    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

  End If

End Sub

As far as i can see i have the right amount of End Ifs for the amount of Ifs.

Martijn Pieters
  • 1,048,767
  • 296
  • 4,058
  • 3,343
  • 2
    `With OutMail ..` missing its `End With` – Alex K. Jul 24 '15 at 10:09
  • Please forgive me, i don't understand what you mean? – Tomas Joe Gemine Jul 24 '15 at 10:52
  • You have `With OutMail` so there must be a matching `End With` to close it - there is not at the moment. Presumably you need it after `.send` – Alex K. Jul 24 '15 at 10:54
  • Hi Alex, Thanks for your assistance with this, i have tried adding an end with and the macro now runs, however it only sends the initial email and fails to send the appointment? any ideas? perhaps i may have added the end if to the wrong place? any suggestions where i should add it. – Tomas Joe Gemine Jul 24 '15 at 11:04
  • Now it compiles its a debugging issue, step through the code and see what's up. – Alex K. Jul 24 '15 at 11:08
  • it seems that i can get each individual code (one to send email to organizer, one to send appointment to assessor) to work individually. whats your opinion on creating a code to run each individual code separate and assigning that code to the button? can you see any problems in doing this? – Tomas Joe Gemine Jul 24 '15 at 14:03

1 Answers1

1

I have reviewed a bit your code, and found 2 things that may influenced the appointment sending :

  1. You save it before sending, which will close the window, and so probably make it impossible to send
  2. You create a second Outlook instance and that is not really necessary and will only use more RAM for nothing (as you don't close it either)

So here is your (reformated) amended code, give it a try :

Sub ACarr_Step2()
    Dim iRet As Integer
    Dim strPrompt As String
    Dim strTitle As String

    ' Promt
    strPrompt = "Have you checked if Joe Bloggs is available?"
    ' Dialog's Title
    strTitle = "Availability Confirmation"
    'Display MessageBox
    iRet = MsgBox(strPrompt, vbYesNo, strTitle)

    ' Check pressed button
    If iRet = vbNo Then
        MsgBox "Please check Availability with Joe Bloggs"
    Else
        Dim OutApp As Object
        Dim OutMail As Object
        Dim myApt As Object

        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)

        assessor = Sheets("ACarr").Range("AB5").Text
        clerk = Sheets("ACarr").Range("AB1").Text
        team = Sheets("ACarr").Range("AB2").Text
        datee = Sheets("ACarr").Range("AB3").Text
        timeslot = Sheets("ACarr").Range("AB4").Text

        On Error Resume Next
        With OutMail
            .To = "Team.organizer@company.co.uk"
            .CC = ""
            .BCC = ""
            .Subject = "DSE Assessment Booking"
            .Body = "Hi there," & vbNewLine & vbNewLine & "Could you please arrange for the agents below to be rota'd off to complete a Desk Assessment." & vbNewLine & vbNewLine & "Assessor: " & assessor & vbNewLine & "Staff Member : " & clerk & vbNewLine & "Team: " & team & vbNewLine & "Date: " & datee & vbNewLine & "Time Slot: " & timeslot & vbNewLine & vbNewLine & "Thank You"

            .Send
        End With

        ' Create the Outlook session
        'Set myoutlook = CreateObject("Outlook.Application")
        ' Create the AppointmentItem
        Set myApt = OutApp.CreateItem(olAppointmentItem)     ' Set the appointment properties

        With myApt
            .Subject = "DSE Assessment Booking"
            .Location = Sheets("ACarr").Range("AB2").Text
            .Start = Sheets("ACarr").Range("AB4").Text
            .Duration = 30
            .Recipients = "Desk.Assessor@Company.co.uk"
            .MeetingStatus = olMeeting
            ' not necessary if recipients are email addresses
            'myapt.Recipients.ResolveAll
            .AllDayEvent = "False"
            .BusyStatus = "2"
            .ReminderSet = False
            .Body = "Hi there," & vbNewLine & vbNewLine & _
                        "Could you please arrange for the agents below to be rota'd off to complete a Desk Assessment." & vbNewLine & vbNewLine & _
                        "Assessor: " & assessor & vbNewLine & _
                        "Staff Member : " & clerk & vbNewLine & _
                        "Team: " & team & vbNewLine & _
                        "Date: " & datee & vbNewLine & _
                        "Time Slot: " & timeslot & vbNewLine & vbNewLine & _
                        "Thank You"
            '.Save
            .Send
        End With

        Application.ScreenUpdating = False
        With Sheets("ACarr")
            .Range("C14").ClearContents
            .Range("C20").ClearContents
            .Range("C26").ClearContents
            .Range("C32").ClearContents
        End With
        Sheets("Menu").Activate
        'enable the application to show screen switching again
        Application.ScreenUpdating = True
        ActiveWorkbook.Save

        MsgBox "Your Email has been sent and changes saved."

        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
        Set myApt = Nothing
    End If
End Sub
R3uK
  • 14,417
  • 7
  • 43
  • 77
  • Thank you for your assistance R3uK. i have tried the ammended code above and still no luck :( it sends the first email perfectly but no appointment comes through. – Tomas Joe Gemine Jul 24 '15 at 13:14
  • it seems that i can get each individual code (one to send email to organizer, one to send appointment to assessor) to work individually. whats your opinion on creating a code to run each individual code separate and assigning that code to the button? could you see any problems in doing this? – Tomas Joe Gemine Jul 24 '15 at 14:03