VBA to create outlook appointment Block If error

mercredi 4 mars 2015

Hi All,



I've got some vba running on a button press.

Basically it works like this...

I want to add an outlook reminder...

I have a yes/no box that is ticked if the reminder is already added which would then mean no further action is required.

If it's no it checks the "ProposedProbationPeriod" field to see if it is blank.

If so it reminds us in 7 days that it is blank.

If it isn't it adds a reminder on the date in that field to outlook.

I keep getting an error at the end of my code saying...



Compile error:



Block If without End If



Here is the VBA...



Private Sub Command15_Click()

DoCmd.RunCommand acCmdSaveRecord

' Exit the procedure if appointment has been added to Outlook.

If Me!ProbationDateAddedtoOutlook = True Then

DoCmd.OpenForm "FrmPrevTrainingRec", , , "StaffID = " & Me!StaffID

Forms("Frm3").SetFocus

DoCmd.Close

Exit Sub

Else

If IsNull([ProposedProbationPeriod]) Then

Dim outobj As Outlook.Application

Dim outappt As Outlook.AppointmentItem

Set outobj = CreateObject("outlook.application")

Set outappt = outobj.CreateItem(olAppointmentItem)

With outappt

.Start = Date + 7 & " " & Me!InsApptTime

.Duration = 15

.Subject = Me!FirstName & " " & LastName & " has no probation period end date"

.Body = Me!FirstName & " " & LastName & " has no probation period end date"

.Location = "None"

.ReminderMinutesBeforeStart = 15

.ReminderSet = True

.Save

End With

DoCmd.OpenForm "FrmPrevTrainingRec", , , "StaffID = " & Me!StaffID

Forms("Frm3").SetFocus

DoCmd.Close

Exit Sub

Else

Set outobj = CreateObject("outlook.application")

Set outappt = outobj.CreateItem(olAppointmentItem)

With outappt

.Start = Me!ProposedProbationPeriod & " " & Me!InsApptTime

.Duration = 15

.Subject = Me!FirstName & " " & LastName & " probation period ends today"

.Body = Me!FirstName & " " & LastName & " probation period ends today"

.Location = "None"

.ReminderMinutesBeforeStart = 15

.ReminderSet = True

.Save

Me!ProbationDateAddedtoOutlook = True

End With

Set outobj = Nothing

DoCmd.OpenForm "FrmPrevTrainingRec", , , "StaffID = " & Me!StaffID

Forms("Frm3").SetFocus

DoCmd.Close

End If

End Sub

VBA to create outlook appointment Block If error

0 commentaires:

Enregistrer un commentaire

Labels