Hi all
I need to automate sending an appointment from Access to a specific Outlook mailbox. I can get it to work fine using the code below, but this puts the appointment into my Outlook Calendar and I need to put it into the calendar of another member of my company. We use Exchange 2003. Any ideas? Many thanks. Peter
Private Sub cmdAddAppt_Click()
On Error GoTo Add_Err
Dim sMessage As String
'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
sMessage = MsgBox("This callback has already been added to Microsoft Outlook", vbExclamation + vbOKOnly, progname)
Exit Sub
'Add a new callback appointment.
Else
Dim objOutlook As Outlook.Application
Dim objAppt As Outlook.AppointmentItem
Set objOutlook = CreateObject("Outlook.Application")
Set objAppt = objOutlook.CreateItem(olAppointmentItem)
With objAppt
.Start = Me!apptDate & " " & Me!apptTime
'.Duration = Me!apptLength
.Subject = "Callback: " & Forms!frmperson!Title & " " & Forms!frmperson!Forename & " " & Forms!frmperson!Surname & ", " & Forms!frmperson!HomePhone & " / " & Forms!frmperson!OtherPhone
If Not IsNull(Me!apptNotes) Then .Body = Me!apptNotes
'If Not IsNull(Me!apptLocation) Then .Location = Me!apptLocation
If Me!apptReminder Then
.ReminderMinutesBeforeStart = Me!ReminderMinutes
.ReminderSet = True
End If
'Set objRecurPattern = .GetRecurrencePattern
'With objRecurPattern
'.RecurrenceType = olRecursWeekly
'.Interval = 1
'Once per week
'.PatternStartDate = #7/9/2003#
'You could get these values
'from new text boxes on the form.
'.PatternEndDate = #7/23/2003#
'End With
.Save
.Close (olSave)
End With
'Release the AppointmentItem object variable.
Set objAppt = Nothing
End If
'Release the Outlook object variable.
Set objOutlook = Nothing
'Set the AddedToOutlook flag, save the record, display a message.
Me!AddedToOutlook = True
DoCmd.RunCommand acCmdSaveRecord
sMessage = MsgBox("Callback Added!", vbExclamation + vbOKOnly, progname)
Exit Sub
Add_Err:
sMessage = MsgBox("Error " & Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, progname)
Exit Sub
End Sub
I need to automate sending an appointment from Access to a specific Outlook mailbox. I can get it to work fine using the code below, but this puts the appointment into my Outlook Calendar and I need to put it into the calendar of another member of my company. We use Exchange 2003. Any ideas? Many thanks. Peter
Private Sub cmdAddAppt_Click()
On Error GoTo Add_Err
Dim sMessage As String
'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
sMessage = MsgBox("This callback has already been added to Microsoft Outlook", vbExclamation + vbOKOnly, progname)
Exit Sub
'Add a new callback appointment.
Else
Dim objOutlook As Outlook.Application
Dim objAppt As Outlook.AppointmentItem
Set objOutlook = CreateObject("Outlook.Application")
Set objAppt = objOutlook.CreateItem(olAppointmentItem)
With objAppt
.Start = Me!apptDate & " " & Me!apptTime
'.Duration = Me!apptLength
.Subject = "Callback: " & Forms!frmperson!Title & " " & Forms!frmperson!Forename & " " & Forms!frmperson!Surname & ", " & Forms!frmperson!HomePhone & " / " & Forms!frmperson!OtherPhone
If Not IsNull(Me!apptNotes) Then .Body = Me!apptNotes
'If Not IsNull(Me!apptLocation) Then .Location = Me!apptLocation
If Me!apptReminder Then
.ReminderMinutesBeforeStart = Me!ReminderMinutes
.ReminderSet = True
End If
'Set objRecurPattern = .GetRecurrencePattern
'With objRecurPattern
'.RecurrenceType = olRecursWeekly
'.Interval = 1
'Once per week
'.PatternStartDate = #7/9/2003#
'You could get these values
'from new text boxes on the form.
'.PatternEndDate = #7/23/2003#
'End With
.Save
.Close (olSave)
End With
'Release the AppointmentItem object variable.
Set objAppt = Nothing
End If
'Release the Outlook object variable.
Set objOutlook = Nothing
'Set the AddedToOutlook flag, save the record, display a message.
Me!AddedToOutlook = True
DoCmd.RunCommand acCmdSaveRecord
sMessage = MsgBox("Callback Added!", vbExclamation + vbOKOnly, progname)
Exit Sub
Add_Err:
sMessage = MsgBox("Error " & Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, progname)
Exit Sub
End Sub