Posting Access data to Outlook

[AndrewDB]

Hi All. I need to present data from a scheduling database in a type of
year/monthly/weekly layout similar to that used by Outlook. Instead of trying
to re-invent the wheel, is there a way that I can post the data to the
Outlook appointments facility so that the Outlook calendar facility can be
used? I will need to delete/update/add data to Outlook without affecting any
other appointment information stored . If this is not possible any other
solution will be appreciated. I am using Office 2007 Prof.

 

[Gary Brown]

If I understand your request correctly, I think the snippet below should get
you there BUT I don't have 2007 so I'm not sure.

'- - - - - - - - - - - - - - - - - -
' Sub Purpose: create help desk appointments
' create personal calendar appointments
' send out email notifications of appointments
' Need reference to Outlook
'- - - - - - - - - - - - - - - - - -
Dim dtStart As Date
Dim dtEnd As Date
Dim oOutlookApp As Outlook.Application
Dim oPersonalAppointment As Outlook.AppointmentItem
Dim oMailItem As Outlook.MailItem
Dim oHelpDeskFolder As Outlook.MAPIFolder
Dim oRecipientFolder As Outlook.MAPIFolder
Dim oNameSpace As Outlook.Namespace
Dim oRecipient As Outlook.Recipient
Dim strBody As String
Dim strLocation As String
Dim strRecipient As String
Dim strSubFolder As String
Dim strSubject As String
Dim varAppointment As Variant


'put this inside a do loop of your records
Set oOutlookApp = CreateObject("Outlook.Application")
Set oNameSpace = Outlook.GetNamespace("Mapi")
Set oMailItem = oOutlookApp.CreateItem(olMailItem)

'test that mail recipient can be found
Set oRecipient = oMailItem.Recipients.Add(strRecipient)
oRecipient.Resolve

'if mail recipient exists then put appointment in public folder,
' on recipient's calendar and send notification email:
'
If oRecipient.Resolve Then
Set oHelpDeskFolder = _
oNameSpace.Folders("Public Folders"). _
Folders("All Public Folders").Folders(strSubFolder)

If oHelpDeskFolder Is Nothing Then
Debug.Print "Public Folders folder not found"
GoTo exit_Sub
End If

Set varAppointment = oHelpDeskFolder.Items.Add

' - - - - - - - - - - - - - - - - - -
'add appointment to public folder
With varAppointment
.Subject = strSubject
.Location = strLocation
.Start = dtStart
.End = dtEnd
.Save
End With
' - - - - - - - - - - - - - - - - - -

'add appointment to personal calendar
Set oRecipientFolder = _
oNameSpace.GetSharedDefaultFolder(oRecipient, olFolderCalendar)
If Not oRecipientFolder Is Nothing Then
Set oPersonalAppointment = oRecipientFolder.Items.Add
If Not oPersonalAppointment Is Nothing Then
With oPersonalAppointment
.Subject = strSubject
.Location = strLocation
.Start = dtStart
.End = dtEnd
.Save
End With
End If
End If

' - - - - - - - - - - - - - - - - - -
'send an email to the recipient that an appointment has been
' added to the their calendar
With oMailItem
.Recipients.Add strRecipient
.Subject = strSubject
.Body = strBody & vbCr & _
vbCr & " " & dtStart & _
vbCr & " - to - " & _
vbCr & " " & dtEnd
.Send
End With
' - - - - - - - - - - - - - - - - - -

End If
End If
'- - - - - - - - - - - - - - - - - -

--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown