结束if，不阻塞if

Question

我已经在下面的代码上工作了好几天了，希望最终的产品能做到两件事。

向团队组织者发送电子邮件，其中包含电子表格中的详细信息。将outlook约会发送给桌面评估员，并提供约会详细信息。

我得到一个错误消息说:

编译错误:

结束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 = "[e-mail]"
        .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 = "[e-mail]"
    .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

到目前为止，我可以看到我有正确的结束if的数量为if的数量

Answer 1

我检查了一下你的代码，发现了两件可能影响约会发送的事情:

1. 您在发送之前保存，这将关闭窗口，因此可能无法发送
2. 你创建了一个第二个Outlook实例，这并不是真正必要的，只会使用更多的RAM(因为你也不关闭它)

所以这是你的(重新调整)修改代码，给它一个尝试:

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 = "[e-mail]"
            .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 = "[e-mail]"
            .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