Viewing Public Folder Calendar Within MS Access

[Dave Hopper]

Hi

I am trying to use automation to link appointments within an MS
Outlook Public Folders Calendar and an MS Access Application.

I have successfully modified existing code to ADD and Delete the
appointments to the Public Folder Calendar and this works well.
However, I need to view individual appointments based on a unique ID
that is stored in the BillingInformation field when an appointment is
added. This is so that the data in access that relates to a job
record can be updated if someone changes the date/time/engineer etc
from within MS Outlook. The fields I need to view are Date, Time,
Subject, Location and Body Text and these should then be displayed in
an access form with controls of the same name.

I have searched the groups and the web and can find no reference to
the code I need, however this must be similar to the code I am using
to delete appointments as this references appointments by the unique
ID that I save the appointment with originally.

I would be so grateful for any code snippets or advice. I have
attached my Delete code below for reference:

Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim strFind As String
Dim objCalFolder As Outlook.MAPIFolder
Dim AllPublicFolders As Outlook.MAPIFolder
Dim MyPublicFolder As Outlook.MAPIFolder
Dim colCalendar As Outlook.Items
Dim objAppt As Outlook.AppointmentItem

Dim myOlApp
Dim mNameSpace

Dim MyItem
Dim strMsg

Dim strPublicFolder
Dim strSubject
Dim strStart
Dim strEnd
Dim strBody
Dim strLocation
Dim strRequiredAttendees
Dim strCategories
Dim strBillingInformation


Const olAppointmentItem = 1

strPublicFolder = ("Office")

If Len(strPublicFolder) > 0 Then

Set objOL = CreateObject("Outlook.Application")
Set mNameSpace = objOL.GetNamespace("MAPI")
'Set objCalFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set objCalFolder = mNameSpace.Folders("Public Folders")
Set AllPublicFolders = objCalFolder.Folders("All Public Folders")
Set MyPublicFolder = AllPublicFolders.Folders("Office")
Set colCalendar = MyPublicFolder.Items

strFind = "[BillingInformation] = " & " " & "" & " " & Me!UniqueID
Set objAppt = colCalendar.Find(strFind)
If Not objAppt Is Nothing Then
objAppt.Delete
End If

Set objOL = Nothing
Set objNS = Nothing
Set objCalFolder = Nothing
Set colCalendar = Nothing

End If

Dave Hopper

 

[Ken Slovak - [MVP - Outlook]]

Instead of objAppt.Delete, it would be:

With objAppt
strBody = .Body
strLocation = .Location
strSubject = .Subject
datStartDate = .Start
End With

Then write them to your Access database.

When you want to know what properties, methods and events an object has use
the Object Browser.

Hi

I am trying to use automation to link appointments within an MS
Outlook Public Folders Calendar and an MS Access Application.

I have successfully modified existing code to ADD and Delete the
appointments to the Public Folder Calendar and this works well.
However, I need to view individual appointments based on a unique ID
that is stored in the BillingInformation field when an appointment is
added. This is so that the data in access that relates to a job
record can be updated if someone changes the date/time/engineer etc
from within MS Outlook. The fields I need to view are Date, Time,
Subject, Location and Body Text and these should then be displayed in
an access form with controls of the same name.

I have searched the groups and the web and can find no reference to
the code I need, however this must be similar to the code I am using
to delete appointments as this references appointments by the unique
ID that I save the appointment with originally.

I would be so grateful for any code snippets or advice. I have
attached my Delete code below for reference:

Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim strFind As String
Dim objCalFolder As Outlook.MAPIFolder
Dim AllPublicFolders As Outlook.MAPIFolder
Dim MyPublicFolder As Outlook.MAPIFolder
Dim colCalendar As Outlook.Items
Dim objAppt As Outlook.AppointmentItem

Dim myOlApp
Dim mNameSpace

Dim MyItem
Dim strMsg

Dim strPublicFolder
Dim strSubject
Dim strStart
Dim strEnd
Dim strBody
Dim strLocation
Dim strRequiredAttendees
Dim strCategories
Dim strBillingInformation


Const olAppointmentItem = 1

strPublicFolder = ("Office")

If Len(strPublicFolder) > 0 Then

Set objOL = CreateObject("Outlook.Application")
Set mNameSpace = objOL.GetNamespace("MAPI")
'Set objCalFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set objCalFolder = mNameSpace.Folders("Public Folders")
Set AllPublicFolders = objCalFolder.Folders("All Public Folders")
Set MyPublicFolder = AllPublicFolders.Folders("Office")
Set colCalendar = MyPublicFolder.Items

strFind = "[BillingInformation] = " & " " & "" & " " & Me!UniqueID
Set objAppt = colCalendar.Find(strFind)
If Not objAppt Is Nothing Then
objAppt.Delete
End If

Set objOL = Nothing
Set objNS = Nothing
Set objCalFolder = Nothing
Set colCalendar = Nothing

End If

Dave Hopper

 

[Dave Hopper]

Instead of objAppt.Delete, it would be:

With objAppt
strBody = .Body
strLocation = .Location
strSubject = .Subject
datStartDate = .Start
End With

Then write them to your Access database.

When you want to know what properties, methods and events an object has use
the Object Browser.

Hi

I am trying to use automation to link appointments within an MS
Outlook Public Folders Calendar and an MS Access Application.

I have successfully modified existing code to ADD and Delete the
appointments to the Public Folder Calendar and this works well.
However, I need to view individual appointments based on a unique ID
that is stored in the BillingInformation field when an appointment is
added. This is so that the data in access that relates to a job
record can be updated if someone changes the date/time/engineer etc
from within MS Outlook. The fields I need to view are Date, Time,
Subject, Location and Body Text and these should then be displayed in
an access form with controls of the same name.

I have searched the groups and the web and can find no reference to
the code I need, however this must be similar to the code I am using
to delete appointments as this references appointments by the unique
ID that I save the appointment with originally.

I would be so grateful for any code snippets or advice. I have
attached my Delete code below for reference:

Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim strFind As String
Dim objCalFolder As Outlook.MAPIFolder
Dim AllPublicFolders As Outlook.MAPIFolder
Dim MyPublicFolder As Outlook.MAPIFolder
Dim colCalendar As Outlook.Items
Dim objAppt As Outlook.AppointmentItem

Dim myOlApp
Dim mNameSpace

Dim MyItem
Dim strMsg

Dim strPublicFolder
Dim strSubject
Dim strStart
Dim strEnd
Dim strBody
Dim strLocation
Dim strRequiredAttendees
Dim strCategories
Dim strBillingInformation


Const olAppointmentItem = 1

strPublicFolder = ("Office")

If Len(strPublicFolder) > 0 Then

Set objOL = CreateObject("Outlook.Application")
Set mNameSpace = objOL.GetNamespace("MAPI")
'Set objCalFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set objCalFolder = mNameSpace.Folders("Public Folders")
Set AllPublicFolders = objCalFolder.Folders("All Public Folders")
Set MyPublicFolder = AllPublicFolders.Folders("Office")
Set colCalendar = MyPublicFolder.Items

strFind = "[BillingInformation] = " & " " & "" & " " & Me!UniqueID
Set objAppt = colCalendar.Find(strFind)
If Not objAppt Is Nothing Then
objAppt.Delete
End If

Set objOL = Nothing
Set objNS = Nothing
Set objCalFolder = Nothing
Set colCalendar = Nothing

End If

Dave Hopper

Thank you for your help, it is appreciated.

I have another question regarding the same problem I would be grateful
for your help on.

What method would you use to write to the database ? I simply want to
update entries that are already there (or create them if they don't
exist), for example: I create an appointment in my ms access database
and press a button to export it, that works fine. When someone
changes this entry directly in the shared pulic folder calendar, I
want to enter my code in an on open form event within ms access that
finds the appointment based on the Unique ID and updates the database.

I can find the correct record based on the data displayed on the form
(using your example and my original code), but I cant seem to write
the code to write to the database in the manner I want.

Would it be possible for you to help me with an example ?

Many thanks

Dave Hopper

 

[Ken Slovak - [MVP - Outlook]]

You can use the Access object model or ADO or DAO to set up a connection to
your database. I don't know what you are using now to read from the
database. I would use ADO code myself. After getting a Connection to the
database I'd get a recordset for the table I wanted to write to and then use
ADO code to write a new row or update it.

See http://www.outlookcode.com/d/database.htm for more information on
database coding.

 

[Ken Slovak - [MVP - Outlook]]

BTW, I'd use a SQL INSERT statement for creating a new row in the database.

 

[Dave Hopper]

BTW, I'd use a SQL INSERT statement for creating a new row in the database.

Hi, thanks for that

after reviewig the link you gave me, I wrote the following code and it
works perfectly, I am indebted to you.

I have another question though! Hope you don't mind. Whilst the
following code will go and find an outlook appointment based upon a
value defined in my form, I have an issue if a user deletes the
appointment in outlook instead of the application. It then errors as
it can't find reference to that appointment.

I have tried to overcome this by either inserting code that skips a
record if it can't find a valid outlook appointment that matches with
one in the database, or actually deletes the orphaned entry in access,
thereby solving the problem permanently. Either option will do!

My problem is that I have written several different routines to do
this and just keep getting errors. Can you help?

Public Function ImportAppointments()

' Set up DAO objects (uses existing "tblAppointments" table)
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("tblAppointments")

Dim Prop As Outlook.UserProperty

Dim objOL As New Outlook.Application
Dim objNS As Outlook.NameSpace
Dim strFind As String
Dim objCalFolder As Outlook.MAPIFolder
Dim AllPublicFolders As Outlook.MAPIFolder
Dim MyPublicFolder As Outlook.MAPIFolder
Dim colCalendar As Outlook.Items
Dim objAppt As Outlook.AppointmentItem

Dim db As Database
Dim rsAppointmentsRecords As Recordset
Dim str As String
Dim TableName As String

Set db = CurrentDb

Dim myOlApp
Dim mNameSpace

Dim MyItem
Dim strMsg

Dim strPublicFolder
Dim strSubject
Dim strStart
Dim strEnd
Dim strBody
Dim strLocation
Dim strRequiredAttendees
Dim strCategories
Dim strBillingInformation
Dim strShow
Dim strUniqueID

Const olAppointmentItem = 1

strPublicFolder = ("Office")

If Len(strPublicFolder) > 0 Then

Set objOL = CreateObject("Outlook.Application")
Set mNameSpace = objOL.GetNamespace("MAPI")
Set objCalFolder = mNameSpace.Folders("Public Folders")
Set AllPublicFolders = objCalFolder.Folders("All Public Folders")
Set MyPublicFolder = AllPublicFolders.Folders("Office")
Set colCalendar = MyPublicFolder.Items

strFind = "[Mileage] = " & " " & "" & " " &
Forms!testform!UniqueID
strShow = "" & " " & Forms!testform!UniqueID
Set objAppt = colCalendar.Find(strFind)

Set rst = CurrentDb.OpenRecordset("tblAppointments")



rst.MoveLast
rst.MoveFirst

Do Until rst.EOF

If rst(0) = strShow Then

With objAppt

strLocation = .Location
strSubject = .Subject
strStart = .Start
strBody = .Body

End With

str = "UPDATE tblAppointments SET tblAppointments.ApptLocation = '" &
strLocation & "'WHERE tblAppointments.UniqueID = '" & strShow & "'"
DoCmd.RunSQL (str)
Debug.Print str
str = "UPDATE tblAppointments SET tblAppointments.Appt = '" &
strSubject & "'WHERE tblAppointments.UniqueID = '" & strShow & "'"
DoCmd.RunSQL (str)
Debug.Print str
str = "UPDATE tblAppointments SET tblAppointments.ApptStartDate = '" &
strStart & "'WHERE tblAppointments.UniqueID = '" & strShow & "'"
DoCmd.RunSQL (str)
Debug.Print str
str = "UPDATE tblAppointments SET tblAppointments.ApptNotes = '" &
strBody & "'WHERE tblAppointments.UniqueID = '" & strShow & "'"
DoCmd.RunSQL (str)
Debug.Print str

End If

rst.MoveNext

Loop

rst.Close

db.Close

'MsgBox "Finished."

Set objOL = Nothing
Set objNS = Nothing
Set objCalFolder = Nothing
Set colCalendar = Nothing
End If

End Function

 

[Ken Slovak - [MVP - Outlook]]

I'd use a Restrict clause rather than Find. That assigns the results of the
filtered Items collection as a new Items collection. I'd then check for
colRestrictedItems.Count > 0 to see if I should run code based on there
being items found from the search string. Or you could just assign an object
using FindFirst and if object Is Nothing skip the other code. If it returned
an object continue with FindNext.

Hi, thanks for that

after reviewig the link you gave me, I wrote the following code and it
works perfectly, I am indebted to you.

I have another question though! Hope you don't mind. Whilst the
following code will go and find an outlook appointment based upon a
value defined in my form, I have an issue if a user deletes the
appointment in outlook instead of the application. It then errors as
it can't find reference to that appointment.

I have tried to overcome this by either inserting code that skips a
record if it can't find a valid outlook appointment that matches with
one in the database, or actually deletes the orphaned entry in access,
thereby solving the problem permanently. Either option will do!

My problem is that I have written several different routines to do
this and just keep getting errors. Can you help?

Public Function ImportAppointments()

' Set up DAO objects (uses existing "tblAppointments" table)
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("tblAppointments")

Dim Prop As Outlook.UserProperty

Dim objOL As New Outlook.Application
Dim objNS As Outlook.NameSpace
Dim strFind As String
Dim objCalFolder As Outlook.MAPIFolder
Dim AllPublicFolders As Outlook.MAPIFolder
Dim MyPublicFolder As Outlook.MAPIFolder
Dim colCalendar As Outlook.Items
Dim objAppt As Outlook.AppointmentItem

Dim db As Database
Dim rsAppointmentsRecords As Recordset
Dim str As String
Dim TableName As String

Set db = CurrentDb

Dim myOlApp
Dim mNameSpace

Dim MyItem
Dim strMsg

Dim strPublicFolder
Dim strSubject
Dim strStart
Dim strEnd
Dim strBody
Dim strLocation
Dim strRequiredAttendees
Dim strCategories
Dim strBillingInformation
Dim strShow
Dim strUniqueID

Const olAppointmentItem = 1

strPublicFolder = ("Office")

If Len(strPublicFolder) > 0 Then

Set objOL = CreateObject("Outlook.Application")
Set mNameSpace = objOL.GetNamespace("MAPI")
Set objCalFolder = mNameSpace.Folders("Public Folders")
Set AllPublicFolders = objCalFolder.Folders("All Public Folders")
Set MyPublicFolder = AllPublicFolders.Folders("Office")
Set colCalendar = MyPublicFolder.Items

strFind = "[Mileage] = " & " " & "" & " " &
Forms!testform!UniqueID
strShow = "" & " " & Forms!testform!UniqueID
Set objAppt = colCalendar.Find(strFind)

Set rst = CurrentDb.OpenRecordset("tblAppointments")



rst.MoveLast
rst.MoveFirst

Do Until rst.EOF

If rst(0) = strShow Then

With objAppt

strLocation = .Location
strSubject = .Subject
strStart = .Start
strBody = .Body

End With

str = "UPDATE tblAppointments SET tblAppointments.ApptLocation = '" &
strLocation & "'WHERE tblAppointments.UniqueID = '" & strShow & "'"
DoCmd.RunSQL (str)
Debug.Print str
str = "UPDATE tblAppointments SET tblAppointments.Appt = '" &
strSubject & "'WHERE tblAppointments.UniqueID = '" & strShow & "'"
DoCmd.RunSQL (str)
Debug.Print str
str = "UPDATE tblAppointments SET tblAppointments.ApptStartDate = '" &
strStart & "'WHERE tblAppointments.UniqueID = '" & strShow & "'"
DoCmd.RunSQL (str)
Debug.Print str
str = "UPDATE tblAppointments SET tblAppointments.ApptNotes = '" &
strBody & "'WHERE tblAppointments.UniqueID = '" & strShow & "'"
DoCmd.RunSQL (str)
Debug.Print str

End If

rst.MoveNext

Loop

rst.Close

db.Close

'MsgBox "Finished."

Set objOL = Nothing
Set objNS = Nothing
Set objCalFolder = Nothing
Set colCalendar = Nothing
End If

End Function

 

[Dave Hopper]

I'd use a Restrict clause rather than Find. That assigns the results of the
filtered Items collection as a new Items collection. I'd then check for
colRestrictedItems.Count > 0 to see if I should run code based on there
being items found from the search string. Or you could just assign an object
using FindFirst and if object Is Nothing skip the other code. If it returned
an object continue with FindNext.

Hi, thanks for that

after reviewig the link you gave me, I wrote the following code and it
works perfectly, I am indebted to you.

I have another question though! Hope you don't mind. Whilst the
following code will go and find an outlook appointment based upon a
value defined in my form, I have an issue if a user deletes the
appointment in outlook instead of the application. It then errors as
it can't find reference to that appointment.

I have tried to overcome this by either inserting code that skips a
record if it can't find a valid outlook appointment that matches with
one in the database, or actually deletes the orphaned entry in access,
thereby solving the problem permanently. Either option will do!

My problem is that I have written several different routines to do
this and just keep getting errors. Can you help?

Public Function ImportAppointments()

' Set up DAO objects (uses existing "tblAppointments" table)
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("tblAppointments")

Dim Prop As Outlook.UserProperty

Dim objOL As New Outlook.Application
Dim objNS As Outlook.NameSpace
Dim strFind As String
Dim objCalFolder As Outlook.MAPIFolder
Dim AllPublicFolders As Outlook.MAPIFolder
Dim MyPublicFolder As Outlook.MAPIFolder
Dim colCalendar As Outlook.Items
Dim objAppt As Outlook.AppointmentItem

Dim db As Database
Dim rsAppointmentsRecords As Recordset
Dim str As String
Dim TableName As String

Set db = CurrentDb

Dim myOlApp
Dim mNameSpace

Dim MyItem
Dim strMsg

Dim strPublicFolder
Dim strSubject
Dim strStart
Dim strEnd
Dim strBody
Dim strLocation
Dim strRequiredAttendees
Dim strCategories
Dim strBillingInformation
Dim strShow
Dim strUniqueID

Const olAppointmentItem = 1

strPublicFolder = ("Office")

If Len(strPublicFolder) > 0 Then

Set objOL = CreateObject("Outlook.Application")
Set mNameSpace = objOL.GetNamespace("MAPI")
Set objCalFolder = mNameSpace.Folders("Public Folders")
Set AllPublicFolders = objCalFolder.Folders("All Public Folders")
Set MyPublicFolder = AllPublicFolders.Folders("Office")
Set colCalendar = MyPublicFolder.Items

strFind = "[Mileage] = " & " " & "" & " " &
Forms!testform!UniqueID
strShow = "" & " " & Forms!testform!UniqueID
Set objAppt = colCalendar.Find(strFind)

Set rst = CurrentDb.OpenRecordset("tblAppointments")



rst.MoveLast
rst.MoveFirst

Do Until rst.EOF

If rst(0) = strShow Then

With objAppt

strLocation = .Location
strSubject = .Subject
strStart = .Start
strBody = .Body

End With

str = "UPDATE tblAppointments SET tblAppointments.ApptLocation = '" &
strLocation & "'WHERE tblAppointments.UniqueID = '" & strShow & "'"
DoCmd.RunSQL (str)
Debug.Print str
str = "UPDATE tblAppointments SET tblAppointments.Appt = '" &
strSubject & "'WHERE tblAppointments.UniqueID = '" & strShow & "'"
DoCmd.RunSQL (str)
Debug.Print str
str = "UPDATE tblAppointments SET tblAppointments.ApptStartDate = '" &
strStart & "'WHERE tblAppointments.UniqueID = '" & strShow & "'"
DoCmd.RunSQL (str)
Debug.Print str
str = "UPDATE tblAppointments SET tblAppointments.ApptNotes = '" &
strBody & "'WHERE tblAppointments.UniqueID = '" & strShow & "'"
DoCmd.RunSQL (str)
Debug.Print str

End If

rst.MoveNext

Loop

rst.Close

db.Close

'MsgBox "Finished."

Set objOL = Nothing
Set objNS = Nothing
Set objCalFolder = Nothing
Set colCalendar = Nothing
End If

End Function

Thank you ...I hadn't thought of that

I am fairly new at this, do you have a code sample I could work with
or a link to some more information ? ...I need a starting point

thx

Dave Hopper

 

[Ken Slovak - [MVP - Outlook]]

Please cut out some of the old threads. When you bottom post and don't do
that it makes it very hard to follow what's going on. Thanks.

You can look over the code samples at www.outlookcode.com and search for
Find or Restrict to see any code samples using those methods. You can also
try your own code and post it back here if you have problems and the people
here would review it for you.