2015-07-24 1 views
0

J'ai travaillé sur le code ci-dessous pendant des jours, j'espère que le produit final fera 2 choses.fin si sans bloc si

Envoyez un e-mail à un organisateur d'équipe avec les détails de la feuille de calcul. Envoyez un rendez-vous à l'évaluateur du bureau avec les détails du rendez-vous.

Je reçois un message d'erreur indiquant:

Compile Erreur:

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 = "[email protected]" 
     .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 = "[email protected]" 
    .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 

Pour autant que je peux voir, je la bonne quantité de fin Ifs pour le montant de Ifs.

+2

'Avec OutMail ..' manquant sa' Fin With' –

+0

S'il vous plaît pardonnez-moi, je ne comprends pas ce que tu veux dire? –

+0

Vous avez 'Avec OutMail' donc il doit y avoir un' End With 'correspondant pour le fermer - il n'y en a pas pour le moment. Vraisemblablement, vous en avez besoin après '.send' –

Répondre

1

J'ai examiné un peu votre code, et trouvé 2 choses qui peuvent influencer la nomination envoi:

  1. Vous l'enregistrer avant d'envoyer, qui fermer la fenêtre, et ainsi faire probablement impossible d'envoyer
  2. vous créez une deuxième instance Outlook et ce n'est pas vraiment nécessaire et ne plus utiliser RAM pour rien (que vous ne fermez pas non plus)

Voici donc votre (reformatée) code modifié, faire un essai:

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 = "[email protected]" 
      .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 = "[email protected]" 
      .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 
+0

Nous vous remercions de votre aide R3uK. J'ai essayé le code ammended ci-dessus et toujours pas de chance :(il envoie le premier e-mail parfaitement, mais aucun rendez-vous vient –

+0

il semble que je peux obtenir chaque code individuel (un pour envoyer un courriel à l'organisateur, un pour envoyer un rendez-vous à l'évaluateur) pour travailler individuellement.Quelle est votre opinion sur la création d'un code pour exécuter chaque code séparé et l'attribution de ce code sur le bouton? Pouvez-vous voir des problèmes à faire cela? –