Connectiing to Outlook

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Here what I want to do.

I want to create a basic database, where the user types in the subject in
the subject textbox and then selects a start time, end time and then a picks
a date. After that the user clicks update and then the database automatically
updates my outlook calendar with the given information. So my question is, is
it possible to have Access automaticaly update your outlook calendar with
appointments.
 
Yes. The code below is designed to be run directly from a FORM and
obtains the appropriate values from the fields on the form.

Sub createOutlookAppointment()

Dim objOutlook As Outlook.Application
Dim nms As Outlook.NameSpace
Dim mailbox As mapiFolder
Dim targetCalendar As mapiFolder
Dim newAppt As Outlook.AppointmentItem
Dim strBodyText As String
Dim strLocation As String

If [Forms]![frmReservationsEntryIndividual]![txtOutlookEntryId] =
"" Or
IsNull([Forms]![frmReservationsEntryIndividual]![txtOutlookEntryId]) =
True Then
DoCmd.Hourglass (True)
[Forms]![frmReservationsEntryIndividual]![txtAdvisory] =
"Accessing Outlook..."
[Forms]![frmReservationsEntryIndividual].Repaint
Set objOutlook = CreateObject("Outlook.application")
Set nms = objOutlook.GetNamespace("MAPI")
Set mailbox = nms.Folders(1)
Set targetCalendar = mailbox.Folders("Calendar")
Set newAppt = objOutlook.CreateItem(olAppointmentItem)

newAppt.UserProperties.Add "dbAccessID", olNumber
newAppt.UserProperties.Add "dbLastModified", olDateTime
newAppt.UserProperties.Add "dbStatus", olText

strBodyText = ""
strBodyText = strBodyText & "Date/Time: " &
[Forms]![frmReservationsEntryIndividual]![dteDate] & " " &
[Forms]![frmReservationsEntryIndividual]![dteTimeScheduled] & Chr(13) &
Chr(10)
strBodyText = strBodyText & "Status: " &
[Forms]![frmReservationsEntryIndividual]![cboStatus].Column(1) & Chr(13)
& Chr(10)
strBodyText = strBodyText & "Name Sign: " &
[Forms]![frmReservationsEntryIndividual]![txtNameSign] & Chr(13) & Chr(10)
strBodyText = strBodyText & "Passenger: " &
[Forms]![frmReservationsEntryIndividual]![txtPrimaryPassengerName] &
Chr(13) & Chr(10)
strBodyText = strBodyText & "PAX Phone: " &
Format([Forms]![frmReservationsEntryIndividual]![txtPrimaryPassengerPhone],
"(000) 000-0000") & Chr(13) & Chr(10)
strBodyText = strBodyText & "--- --- --- --- ---" & Chr(13) &
Chr(10)
strBodyText = strBodyText & "Client:" &
[Forms]![frmReservationsEntryIndividual]![cboClient].Column(1) & Chr(13)
& Chr(10)
strBodyText = strBodyText & "Contact: " &
[Forms]![frmReservationsEntryIndividual]![txtContactNameFirst] & " " &
[Forms]![frmReservationsEntryIndividual]![txtContactNameLast] & Chr(13)
& Chr(10)
strBodyText = strBodyText & "Phone: " &
Format([Forms]![frmReservationsEntryIndividual]![txtContactPhone],
"(000) 000-0000") & Chr(13) & Chr(10)
strBodyText = strBodyText & "--- --- --- --- ---" & Chr(13) &
Chr(10)
strBodyText = strBodyText & "From: " &
[Forms]![frmReservationsEntryIndividual]![cboOrigination] & Chr(13) &
Chr(10)
strBodyText = strBodyText & "To: " &
[Forms]![frmReservationsEntryIndividual]![cboDestination] & Chr(13) &
Chr(10)
strBodyText = strBodyText & "Fare: " &
Format([Forms]![frmReservationsEntryIndividual]![curFare], "Currency") &
Chr(13) & Chr(10)
strBodyText = strBodyText & "Vehicle: " &
[Forms]![frmReservationsEntryIndividual]![cboVehicleType].Column(1) &
Chr(13) & Chr(10)
strBodyText = strBodyText & "Party Size: " &
[Forms]![frmReservationsEntryIndividual]![intNumberofPassengers] &
Chr(13) & Chr(10)
strBodyText = strBodyText & "Car Seat: " &
[Forms]![frmReservationsEntryIndividual]![cboCarSeat] & Chr(13) & Chr(10)
strBodyText = strBodyText & "--- --- --- --- ---" & Chr(13) &
Chr(10)
strBodyText = strBodyText & "Comments:" & Chr(13) & Chr(10)
strBodyText = strBodyText &
[Forms]![frmReservationsEntryIndividual]![txtComments]

strLocation = DLookup("txtLocationShortDescription",
"tblLocations", "[txtLocationName] =
[Forms]![frmReservationsEntryIndividual]![cboOrigination]")
strLocation = strLocation & " - "
strLocation = strLocation &
DLookup("txtLocationShortDescription", "tblLocations",
"[txtLocationName] =
[Forms]![frmReservationsEntryIndividual]![cboDestination]")

[Forms]![frmReservationsEntryIndividual]![txtAdvisory] =
"Creating new appointment..."
[Forms]![frmReservationsEntryIndividual].Repaint

With newAppt
.Start = [Forms]![frmReservationsEntryIndividual]![dteDate]
& " " & [Forms]![frmReservationsEntryIndividual]![dteTimeScheduled]
.End = [Forms]![frmReservationsEntryIndividual]![dteDate] &
" " & [Forms]![frmReservationsEntryIndividual]![dteTimeScheduled]
.Subject =
[Forms]![frmReservationsEntryIndividual]![txtPrimaryPassengerName]
.Location = strLocation
.UserProperties(1) =
[Forms]![frmReservationsEntryIndividual]![lngTransportID]
.UserProperties(2) = Now
.UserProperties(3) =
[Forms]![frmReservationsEntryIndividual]![cboStatus].Column(1)
.Body = strBodyText
.BusyStatus = olBusy
.Categories = "Reservations"
.MessageClass = "IPM.Appointment.Reservations"
.Save
End With

[Forms]![frmReservationsEntryIndividual]![txtAdvisory] = "New
appointment created"
[Forms]![frmReservationsEntryIndividual].Repaint

[Forms]![frmReservationsEntryIndividual]![txtOutlookEntryId] =
newAppt.EntryID

DoCmd.Hourglass (False)

If IsNull(newAppt.EntryID) = False Then
MsgBox ("Outlook appointment created.")
Else
MsgBox ("Unable to confirm that the Outlook appointment was
created.")
End If

Set newAppt = Nothing
Set targetCalendar = Nothing
Set mailbox = Nothing
Set nms = Nothing
Set objOutlook = Nothing
Else
MsgBox ("An Outlook appointment has already been scheduled for
this reservation.")
End If

[Forms]![frmReservationsEntryIndividual]![txtAdvisory] = ""

End Sub

Sub changeOutlookAppointment()

Dim objOutlook As Outlook.Application
Dim nms As Outlook.NameSpace
Dim mailbox As mapiFolder
Dim targetCalendar As mapiFolder
Dim targetAppointmentGroup As Outlook.Items
Dim targetAppointment As Outlook.AppointmentItem
Dim i
Dim strBodyText As String
Dim flgAppointmentFound As Boolean
Dim strLocation As String


If [Forms]![frmReservationsEntryIndividual]![txtOutlookEntryId] <>
"" And
IsNull([Forms]![frmReservationsEntryIndividual]![txtOutlookEntryId]) =
False Then
DoCmd.Hourglass (True)
[Forms]![frmReservationsEntryIndividual]![txtAdvisory] =
"Accessing Outlook..."
[Forms]![frmReservationsEntryIndividual].Repaint
Set objOutlook = CreateObject("Outlook.application")
Set nms = objOutlook.GetNamespace("MAPI")
Set mailbox = nms.Folders(1)
Set targetCalendar = mailbox.Folders("Calendar")
Set targetAppointmentGroup =
mailbox.Folders("Calendar").Items.Restrict("[Start] > '#" & DateAdd("d",
-7, Date) & "#'")

i = 1
flgAppointmentFound = False
[Forms]![frmReservationsEntryIndividual]![txtAdvisory] =
"Searching for appointment..."
[Forms]![frmReservationsEntryIndividual].Repaint
While (i <= targetAppointmentGroup.Count)
[Forms]![frmReservationsEntryIndividual]![txtAdvisory] =
"Searching for appointment..." & Time()
[Forms]![frmReservationsEntryIndividual].Repaint
If targetAppointmentGroup.Item(i).EntryID =
[Forms]![frmReservationsEntryIndividual]![txtOutlookEntryId] Then
Set targetAppointment = targetAppointmentGroup.Item(i)
flgAppointmentFound = True
[Forms]![frmReservationsEntryIndividual]![txtAdvisory]
= "Appointment found"
[Forms]![frmReservationsEntryIndividual].Repaint
End If
i = i + 1
Wend

If flgAppointmentFound = False Then
MsgBox ("Unable to update Outlook appointment. The
appointment could not be found.")
Exit Sub
End If

[Forms]![frmReservationsEntryIndividual]![txtAdvisory] =
"Preparing to update appointment..."
[Forms]![frmReservationsEntryIndividual].Repaint

targetAppointment.UserProperties.Add "dbAccessID", olNumber
targetAppointment.UserProperties.Add "dbLastModified", olDateTime
targetAppointment.UserProperties.Add "dbStatus", olText

strBodyText = ""
strBodyText = strBodyText & "Date/Time: " &
[Forms]![frmReservationsEntryIndividual]![dteDate] & " " &
[Forms]![frmReservationsEntryIndividual]![dteTimeScheduled] & Chr(13) &
Chr(10)
strBodyText = strBodyText & "Status: " &
[Forms]![frmReservationsEntryIndividual]![cboStatus].Column(1) & Chr(13)
& Chr(10)
strBodyText = strBodyText & "Name Sign: " &
[Forms]![frmReservationsEntryIndividual]![txtNameSign] & Chr(13) & Chr(10)
strBodyText = strBodyText & "Passenger: " &
[Forms]![frmReservationsEntryIndividual]![txtPrimaryPassengerName] &
Chr(13) & Chr(10)
strBodyText = strBodyText & "PAX Phone: " &
Format([Forms]![frmReservationsEntryIndividual]![txtPrimaryPassengerPhone],
"(000) 000-0000") & Chr(13) & Chr(10)
strBodyText = strBodyText & "--- --- --- --- ---" & Chr(13) &
Chr(10)
strBodyText = strBodyText & "Client:" &
[Forms]![frmReservationsEntryIndividual]![cboClient].Column(1) & Chr(13)
& Chr(10)
strBodyText = strBodyText & "Contact: " &
[Forms]![frmReservationsEntryIndividual]![txtContactNameFirst] & " " &
[Forms]![frmReservationsEntryIndividual]![txtContactNameLast] & Chr(13)
& Chr(10)
strBodyText = strBodyText & "Phone: " &
Format([Forms]![frmReservationsEntryIndividual]![txtContactPhone],
"(000) 000-0000") & Chr(13) & Chr(10)
strBodyText = strBodyText & "--- --- --- --- ---" & Chr(13) &
Chr(10)
strBodyText = strBodyText & "From: " &
[Forms]![frmReservationsEntryIndividual]![cboOrigination] & Chr(13) &
Chr(10)
strBodyText = strBodyText & "To: " &
[Forms]![frmReservationsEntryIndividual]![cboDestination] & Chr(13) &
Chr(10)
strBodyText = strBodyText & "Fare: " &
Format([Forms]![frmReservationsEntryIndividual]![curFare], "Currency") &
Chr(13) & Chr(10)
strBodyText = strBodyText & "Vehicle: " &
[Forms]![frmReservationsEntryIndividual]![cboVehicleType].Column(1) &
Chr(13) & Chr(10)
strBodyText = strBodyText & "Party Size: " &
[Forms]![frmReservationsEntryIndividual]![intNumberofPassengers] &
Chr(13) & Chr(10)
strBodyText = strBodyText & "Car Seat: " &
[Forms]![frmReservationsEntryIndividual]![cboCarSeat] & Chr(13) & Chr(10)
strBodyText = strBodyText & "--- --- --- --- ---" & Chr(13) &
Chr(10)
strBodyText = strBodyText & "Comments:" & Chr(13) & Chr(10)
strBodyText = strBodyText &
[Forms]![frmReservationsEntryIndividual]![txtComments]

strLocation = DLookup("txtLocationShortDescription",
"tblLocations", "[txtLocationName] =
[Forms]![frmReservationsEntryIndividual]![cboOrigination]")
strLocation = strLocation & " - "
strLocation = strLocation &
DLookup("txtLocationShortDescription", "tblLocations",
"[txtLocationName] =
[Forms]![frmReservationsEntryIndividual]![cboDestination]")

[Forms]![frmReservationsEntryIndividual]![txtAdvisory] =
"Updating appointment..."
[Forms]![frmReservationsEntryIndividual].Repaint

With targetAppointment
.Start = [Forms]![frmReservationsEntryIndividual]![dteDate]
& " " & [Forms]![frmReservationsEntryIndividual]![dteTimeScheduled]
.End = [Forms]![frmReservationsEntryIndividual]![dteDate] &
" " & [Forms]![frmReservationsEntryIndividual]![dteTimeScheduled]
.Subject =
[Forms]![frmReservationsEntryIndividual]![txtPrimaryPassengerName]
.Location = strLocation
.UserProperties(1) =
[Forms]![frmReservationsEntryIndividual]![lngTransportID]
.UserProperties(2) = Now
.UserProperties(3) =
[Forms]![frmReservationsEntryIndividual]![cboStatus].Column(1)
.Body = strBodyText
.BusyStatus = olBusy
.Categories = "Reservations"
.Save
End With

[Forms]![frmReservationsEntryIndividual]![txtAdvisory] =
"Appointment updated"
[Forms]![frmReservationsEntryIndividual].Repaint
DoCmd.Hourglass (False)

MsgBox ("Outlook appointment updated.")

Set targetAppointment = Nothing
Set targetAppointmentGroup = Nothing
Set targetCalendar = Nothing
Set mailbox = Nothing
Set nms = Nothing
Set objOutlook = Nothing
Else
MsgBox ("An Outlook appointment has not been scheduled for this
reservation.")
End If

End Sub
 
David Thanks - that was a little feature "nice to have" I was planning to add
into my application when I got the time to get around to it. You have saved
me hours - gotta love these sites.


David C. Holley said:
Yes. The code below is designed to be run directly from a FORM and
obtains the appropriate values from the fields on the form.

Sub createOutlookAppointment()

Dim objOutlook As Outlook.Application
Dim nms As Outlook.NameSpace
Dim mailbox As mapiFolder
Dim targetCalendar As mapiFolder
Dim newAppt As Outlook.AppointmentItem
Dim strBodyText As String
Dim strLocation As String

If [Forms]![frmReservationsEntryIndividual]![txtOutlookEntryId] =
"" Or
IsNull([Forms]![frmReservationsEntryIndividual]![txtOutlookEntryId]) =
True Then
DoCmd.Hourglass (True)
[Forms]![frmReservationsEntryIndividual]![txtAdvisory] =
"Accessing Outlook..."
[Forms]![frmReservationsEntryIndividual].Repaint
Set objOutlook = CreateObject("Outlook.application")
Set nms = objOutlook.GetNamespace("MAPI")
Set mailbox = nms.Folders(1)
Set targetCalendar = mailbox.Folders("Calendar")
Set newAppt = objOutlook.CreateItem(olAppointmentItem)

newAppt.UserProperties.Add "dbAccessID", olNumber
newAppt.UserProperties.Add "dbLastModified", olDateTime
newAppt.UserProperties.Add "dbStatus", olText

strBodyText = ""
strBodyText = strBodyText & "Date/Time: " &
[Forms]![frmReservationsEntryIndividual]![dteDate] & " " &
[Forms]![frmReservationsEntryIndividual]![dteTimeScheduled] & Chr(13) &
Chr(10)
strBodyText = strBodyText & "Status: " &
[Forms]![frmReservationsEntryIndividual]![cboStatus].Column(1) & Chr(13)
& Chr(10)
strBodyText = strBodyText & "Name Sign: " &
[Forms]![frmReservationsEntryIndividual]![txtNameSign] & Chr(13) & Chr(10)
strBodyText = strBodyText & "Passenger: " &
[Forms]![frmReservationsEntryIndividual]![txtPrimaryPassengerName] &
Chr(13) & Chr(10)
strBodyText = strBodyText & "PAX Phone: " &
Format([Forms]![frmReservationsEntryIndividual]![txtPrimaryPassengerPhone],
"(000) 000-0000") & Chr(13) & Chr(10)
strBodyText = strBodyText & "--- --- --- --- ---" & Chr(13) &
Chr(10)
strBodyText = strBodyText & "Client:" &
[Forms]![frmReservationsEntryIndividual]![cboClient].Column(1) & Chr(13)
& Chr(10)
strBodyText = strBodyText & "Contact: " &
[Forms]![frmReservationsEntryIndividual]![txtContactNameFirst] & " " &
[Forms]![frmReservationsEntryIndividual]![txtContactNameLast] & Chr(13)
& Chr(10)
strBodyText = strBodyText & "Phone: " &
Format([Forms]![frmReservationsEntryIndividual]![txtContactPhone],
"(000) 000-0000") & Chr(13) & Chr(10)
strBodyText = strBodyText & "--- --- --- --- ---" & Chr(13) &
Chr(10)
strBodyText = strBodyText & "From: " &
[Forms]![frmReservationsEntryIndividual]![cboOrigination] & Chr(13) &
Chr(10)
strBodyText = strBodyText & "To: " &
[Forms]![frmReservationsEntryIndividual]![cboDestination] & Chr(13) &
Chr(10)
strBodyText = strBodyText & "Fare: " &
Format([Forms]![frmReservationsEntryIndividual]![curFare], "Currency") &
Chr(13) & Chr(10)
strBodyText = strBodyText & "Vehicle: " &
[Forms]![frmReservationsEntryIndividual]![cboVehicleType].Column(1) &
Chr(13) & Chr(10)
strBodyText = strBodyText & "Party Size: " &
[Forms]![frmReservationsEntryIndividual]![intNumberofPassengers] &
Chr(13) & Chr(10)
strBodyText = strBodyText & "Car Seat: " &
[Forms]![frmReservationsEntryIndividual]![cboCarSeat] & Chr(13) & Chr(10)
strBodyText = strBodyText & "--- --- --- --- ---" & Chr(13) &
Chr(10)
strBodyText = strBodyText & "Comments:" & Chr(13) & Chr(10)
strBodyText = strBodyText &
[Forms]![frmReservationsEntryIndividual]![txtComments]

strLocation = DLookup("txtLocationShortDescription",
"tblLocations", "[txtLocationName] =
[Forms]![frmReservationsEntryIndividual]![cboOrigination]")
strLocation = strLocation & " - "
strLocation = strLocation &
DLookup("txtLocationShortDescription", "tblLocations",
"[txtLocationName] =
[Forms]![frmReservationsEntryIndividual]![cboDestination]")

[Forms]![frmReservationsEntryIndividual]![txtAdvisory] =
"Creating new appointment..."
[Forms]![frmReservationsEntryIndividual].Repaint

With newAppt
.Start = [Forms]![frmReservationsEntryIndividual]![dteDate]
& " " & [Forms]![frmReservationsEntryIndividual]![dteTimeScheduled]
.End = [Forms]![frmReservationsEntryIndividual]![dteDate] &
" " & [Forms]![frmReservationsEntryIndividual]![dteTimeScheduled]
.Subject =
[Forms]![frmReservationsEntryIndividual]![txtPrimaryPassengerName]
.Location = strLocation
.UserProperties(1) =
[Forms]![frmReservationsEntryIndividual]![lngTransportID]
.UserProperties(2) = Now
.UserProperties(3) =
[Forms]![frmReservationsEntryIndividual]![cboStatus].Column(1)
.Body = strBodyText
.BusyStatus = olBusy
.Categories = "Reservations"
.MessageClass = "IPM.Appointment.Reservations"
.Save
End With

[Forms]![frmReservationsEntryIndividual]![txtAdvisory] = "New
appointment created"
[Forms]![frmReservationsEntryIndividual].Repaint

[Forms]![frmReservationsEntryIndividual]![txtOutlookEntryId] =
newAppt.EntryID

DoCmd.Hourglass (False)

If IsNull(newAppt.EntryID) = False Then
MsgBox ("Outlook appointment created.")
Else
MsgBox ("Unable to confirm that the Outlook appointment was
created.")
End If

Set newAppt = Nothing
Set targetCalendar = Nothing
Set mailbox = Nothing
Set nms = Nothing
Set objOutlook = Nothing
Else
MsgBox ("An Outlook appointment has already been scheduled for
this reservation.")
End If

[Forms]![frmReservationsEntryIndividual]![txtAdvisory] = ""

End Sub

Sub changeOutlookAppointment()

Dim objOutlook As Outlook.Application
Dim nms As Outlook.NameSpace
Dim mailbox As mapiFolder
Dim targetCalendar As mapiFolder
Dim targetAppointmentGroup As Outlook.Items
Dim targetAppointment As Outlook.AppointmentItem
Dim i
Dim strBodyText As String
Dim flgAppointmentFound As Boolean
Dim strLocation As String


If [Forms]![frmReservationsEntryIndividual]![txtOutlookEntryId] <>
"" And
IsNull([Forms]![frmReservationsEntryIndividual]![txtOutlookEntryId]) =
False Then
DoCmd.Hourglass (True)
[Forms]![frmReservationsEntryIndividual]![txtAdvisory] =
"Accessing Outlook..."
[Forms]![frmReservationsEntryIndividual].Repaint
Set objOutlook = CreateObject("Outlook.application")
Set nms = objOutlook.GetNamespace("MAPI")
Set mailbox = nms.Folders(1)
Set targetCalendar = mailbox.Folders("Calendar")
Set targetAppointmentGroup =
mailbox.Folders("Calendar").Items.Restrict("[Start] > '#" & DateAdd("d",
-7, Date) & "#'")

i = 1
flgAppointmentFound = False
[Forms]![frmReservationsEntryIndividual]![txtAdvisory] =
"Searching for appointment..."
[Forms]![frmReservationsEntryIndividual].Repaint
While (i <= targetAppointmentGroup.Count)
[Forms]![frmReservationsEntryIndividual]![txtAdvisory] =
"Searching for appointment..." & Time()
[Forms]![frmReservationsEntryIndividual].Repaint
If targetAppointmentGroup.Item(i).EntryID =
[Forms]![frmReservationsEntryIndividual]![txtOutlookEntryId] Then
Set targetAppointment = targetAppointmentGroup.Item(i)
flgAppointmentFound = True
[Forms]![frmReservationsEntryIndividual]![txtAdvisory]
= "Appointment found"
[Forms]![frmReservationsEntryIndividual].Repaint
End If
i = i + 1
Wend

If flgAppointmentFound = False Then
MsgBox ("Unable to update Outlook appointment. The
appointment could not be found.")
Exit Sub
End If

[Forms]![frmReservationsEntryIndividual]![txtAdvisory] =
"Preparing to update appointment..."
[Forms]![frmReservationsEntryIndividual].Repaint

targetAppointment.UserProperties.Add "dbAccessID", olNumber
targetAppointment.UserProperties.Add "dbLastModified", olDateTime
targetAppointment.UserProperties.Add "dbStatus", olText

strBodyText = ""
strBodyText = strBodyText & "Date/Time: " &
[Forms]![frmReservationsEntryIndividual]![dteDate] & " " &
[Forms]![frmReservationsEntryIndividual]![dteTimeScheduled] & Chr(13) &
Chr(10)
strBodyText = strBodyText & "Status: " &
[Forms]![frmReservationsEntryIndividual]![cboStatus].Column(1) & Chr(13)
& Chr(10)
strBodyText = strBodyText & "Name Sign: " &
[Forms]![frmReservationsEntryIndividual]![txtNameSign] & Chr(13) & Chr(10)
strBodyText = strBodyText & "Passenger: " &
[Forms]![frmReservationsEntryIndividual]![txtPrimaryPassengerName] &
Chr(13) & Chr(10)
strBodyText = strBodyText & "PAX Phone: " &
Format([Forms]![frmReservationsEntryIndividual]![txtPrimaryPassengerPhone],
"(000) 000-0000") & Chr(13) & Chr(10)
strBodyText = strBodyText & "--- --- --- --- ---" & Chr(13) &
Chr(10)
strBodyText = strBodyText & "Client:" &
[Forms]![frmReservationsEntryIndividual]![cboClient].Column(1) & Chr(13)
& Chr(10)
strBodyText = strBodyText & "Contact: " &
[Forms]![frmReservationsEntryIndividual]![txtContactNameFirst] & " " &
[Forms]![frmReservationsEntryIndividual]![txtContactNameLast] & Chr(13)
& Chr(10)
strBodyText = strBodyText & "Phone: " &
Format([Forms]![frmReservationsEntryIndividual]![txtContactPhone],
"(000) 000-0000") & Chr(13) & Chr(10)
strBodyText = strBodyText & "--- --- --- --- ---" & Chr(13) &
Chr(10)
strBodyText = strBodyText & "From: " &
[Forms]![frmReservationsEntryIndividual]![cboOrigination] & Chr(13) &
Chr(10)
strBodyText = strBodyText & "To: " &
[Forms]![frmReservationsEntryIndividual]![cboDestination] & Chr(13) &
Chr(10)
strBodyText = strBodyText & "Fare: " &
Format([Forms]![frmReservationsEntryIndividual]![curFare], "Currency") &
Chr(13) & Chr(10)
strBodyText = strBodyText & "Vehicle: " &
[Forms]![frmReservationsEntryIndividual]![cboVehicleType].Column(1) &
Chr(13) & Chr(10)
strBodyText = strBodyText & "Party Size: " &
[Forms]![frmReservationsEntryIndividual]![intNumberofPassengers] &
Chr(13) & Chr(10)
strBodyText = strBodyText & "Car Seat: " &
[Forms]![frmReservationsEntryIndividual]![cboCarSeat] & Chr(13) & Chr(10)
strBodyText = strBodyText & "--- --- --- --- ---" & Chr(13) &
Chr(10)
strBodyText = strBodyText & "Comments:" & Chr(13) & Chr(10)
strBodyText = strBodyText &
[Forms]![frmReservationsEntryIndividual]![txtComments]

strLocation = DLookup("txtLocationShortDescription",
"tblLocations", "[txtLocationName] =
[Forms]![frmReservationsEntryIndividual]![cboOrigination]")
strLocation = strLocation & " - "
strLocation = strLocation &
DLookup("txtLocationShortDescription", "tblLocations",
"[txtLocationName] =
[Forms]![frmReservationsEntryIndividual]![cboDestination]")

[Forms]![frmReservationsEntryIndividual]![txtAdvisory] =
"Updating appointment..."
[Forms]![frmReservationsEntryIndividual].Repaint

With targetAppointment
.Start = [Forms]![frmReservationsEntryIndividual]![dteDate]
& " " & [Forms]![frmReservationsEntryIndividual]![dteTimeScheduled]
.End = [Forms]![frmReservationsEntryIndividual]![dteDate] &
" " & [Forms]![frmReservationsEntryIndividual]![dteTimeScheduled]
.Subject =
[Forms]![frmReservationsEntryIndividual]![txtPrimaryPassengerName]
.Location = strLocation
.UserProperties(1) =
[Forms]![frmReservationsEntryIndividual]![lngTransportID]
.UserProperties(2) = Now
.UserProperties(3) =
[Forms]![frmReservationsEntryIndividual]![cboStatus].Column(1)
.Body = strBodyText
.BusyStatus = olBusy
.Categories = "Reservations"
.Save
End With

[Forms]![frmReservationsEntryIndividual]![txtAdvisory] =
"Appointment updated"
[Forms]![frmReservationsEntryIndividual].Repaint
DoCmd.Hourglass (False)

MsgBox ("Outlook appointment updated.")

Set targetAppointment = Nothing
Set targetAppointmentGroup = Nothing
Set targetCalendar = Nothing
Set mailbox = Nothing
Set nms = Nothing
Set objOutlook = Nothing
Else
MsgBox ("An Outlook appointment has not been scheduled for this
reservation.")
End If

End Sub

Yes go to
http://support.microsoft.com/?kbid=209963
For how
Click to expand...
Click to expand...
 
Back
Top