L
Legacy 128378
Guest
Updating Outlook Appointment, I am using the below code to create an appointment in Outlook 2007 from Access 2007, the code works great but second piece of code to update the Appointment does not work quite right?
WORKING CODE:
Private Sub New_Appointment_Click()
' Save record first to be sure required fields are filled.
DoCmd.RunCommand acCmdSaveRecord
' Exit the procedure if appointment has been added to Outlook.
If Me!AddedToOutlook = True Then
MsgBox "This appointment already added to Microsoft Outlook"
Exit Sub
' Add a new appointment.
Else
Dim OutObj As Outlook.Application
Dim OutAppt As Outlook.AppointmentItem
Set OutObj = CreateObject("outlook.application")
Set OutAppt = OutObj.CreateItem(olAppointmentItem)
With OutAppt
.Start = Me!ApptDate & " " & Me!ApptTime
.Duration = Me!ApptLength
.Subject = Me.AppointmentID & " " & Me.InterpreterINT
.Importance = olImportanceHigh
.Categories = "New"
If Not IsNull(Me!ApptNotes) Then .Body = Now() & Me!ApptNotes & " " & Me!Location_for_Services_Requested
If Not IsNull(Me!Appt_Address) Then .Location = Me!Appt_Address
If Me!ApptReminder Then
.ReminderMinutesBeforeStart = Me!ReminderMinutes
.ReminderSet = True
End If
.Save
End With
End If
' Release the Outlook object variable.
Set OutObj = Nothing
' Set the AddedToOutlook flag, save the record, display a message.
Me!AddedToOutlook = True
DoCmd.RunCommand acCmdSaveRecord
MsgBox "New Appointment Added!"
Exit Sub
AddAppt_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub
THE BELOW CODE NOT WORKING
Private Sub New_Appointment_Click()
' Save record first to be sure required fields are filled.
DoCmd.RunCommand acCmdSaveRecord
' Exit the procedure if appointment has been added to Outlook.
If Me!AddedToOutlook = True Then
MsgBox "This appointment already added to Microsoft Outlook"
Exit Sub
' Add a new appointment.
Else
Dim OutObj As Outlook.Application
Dim OutAppt As Outlook.AppointmentItem
Set OutObj = CreateObject("outlook.application")
Set OutAppt = OutObj.CreateItem(olAppointmentItem)
With OutAppt
.Start = Me!ApptDate & " " & Me!ApptTime
.Duration = Me!ApptLength
.Subject = Me.AppointmentID & " " & Me.InterpreterINT
.Importance = olImportanceHigh
.Categories = "New"
If Not IsNull(Me!ApptNotes) Then .Body = Now() & Me!ApptNotes & " " & Me!Location_for_Services_Requested
If Not IsNull(Me!Appt_Address) Then .Location = Me!Appt_Address
If Me!ApptReminder Then
.ReminderMinutesBeforeStart = Me!ReminderMinutes
.ReminderSet = True
End If
.Save
End With
End If
' Release the Outlook object variable.
Set OutObj = Nothing
' Set the AddedToOutlook flag, save the record, display a message.
Me!AddedToOutlook = True
DoCmd.RunCommand acCmdSaveRecord
MsgBox "New Appointment Added!"
Exit Sub
AddAppt_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub
WORKING CODE:
Private Sub New_Appointment_Click()
' Save record first to be sure required fields are filled.
DoCmd.RunCommand acCmdSaveRecord
' Exit the procedure if appointment has been added to Outlook.
If Me!AddedToOutlook = True Then
MsgBox "This appointment already added to Microsoft Outlook"
Exit Sub
' Add a new appointment.
Else
Dim OutObj As Outlook.Application
Dim OutAppt As Outlook.AppointmentItem
Set OutObj = CreateObject("outlook.application")
Set OutAppt = OutObj.CreateItem(olAppointmentItem)
With OutAppt
.Start = Me!ApptDate & " " & Me!ApptTime
.Duration = Me!ApptLength
.Subject = Me.AppointmentID & " " & Me.InterpreterINT
.Importance = olImportanceHigh
.Categories = "New"
If Not IsNull(Me!ApptNotes) Then .Body = Now() & Me!ApptNotes & " " & Me!Location_for_Services_Requested
If Not IsNull(Me!Appt_Address) Then .Location = Me!Appt_Address
If Me!ApptReminder Then
.ReminderMinutesBeforeStart = Me!ReminderMinutes
.ReminderSet = True
End If
.Save
End With
End If
' Release the Outlook object variable.
Set OutObj = Nothing
' Set the AddedToOutlook flag, save the record, display a message.
Me!AddedToOutlook = True
DoCmd.RunCommand acCmdSaveRecord
MsgBox "New Appointment Added!"
Exit Sub
AddAppt_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub
THE BELOW CODE NOT WORKING
Private Sub New_Appointment_Click()
' Save record first to be sure required fields are filled.
DoCmd.RunCommand acCmdSaveRecord
' Exit the procedure if appointment has been added to Outlook.
If Me!AddedToOutlook = True Then
MsgBox "This appointment already added to Microsoft Outlook"
Exit Sub
' Add a new appointment.
Else
Dim OutObj As Outlook.Application
Dim OutAppt As Outlook.AppointmentItem
Set OutObj = CreateObject("outlook.application")
Set OutAppt = OutObj.CreateItem(olAppointmentItem)
With OutAppt
.Start = Me!ApptDate & " " & Me!ApptTime
.Duration = Me!ApptLength
.Subject = Me.AppointmentID & " " & Me.InterpreterINT
.Importance = olImportanceHigh
.Categories = "New"
If Not IsNull(Me!ApptNotes) Then .Body = Now() & Me!ApptNotes & " " & Me!Location_for_Services_Requested
If Not IsNull(Me!Appt_Address) Then .Location = Me!Appt_Address
If Me!ApptReminder Then
.ReminderMinutesBeforeStart = Me!ReminderMinutes
.ReminderSet = True
End If
.Save
End With
End If
' Release the Outlook object variable.
Set OutObj = Nothing
' Set the AddedToOutlook flag, save the record, display a message.
Me!AddedToOutlook = True
DoCmd.RunCommand acCmdSaveRecord
MsgBox "New Appointment Added!"
Exit Sub
AddAppt_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub