Accessing Shared Outlook Calendars

Question

0.00/5 (No votes)

See more:

Hi..

I am a newbie in development. At work I have a personal calendar and then there are shared calendars that I have access to. I am trying to write a script that retrieves the appointments in each of these shared calendars, but the code I currently use (adapted from Greg Thatcher) only allows me to retrieve appointments in MY calendar. Any assistance is appreciated. below is the code I have.

*-----------------------

VB

Option Explicit
Private Sub CommandButton1_Click()
    GetListOfAppointmentsUsingPropertyAccessor
    Exit Sub
End Sub

Public Sub GetListOfAppointmentsUsingPropertyAccessor()
    On Error GoTo On_Error
    Dim Session As Outlook.NameSpace
    Dim Report As String
    Dim szNewDate As String
    Dim AppointmentsFolder As Outlook.Folder
    Dim currentItem As Object
    Dim currentAppointment As AppointmentItem
    Set Session = Application.Session
    Set AppointmentsFolder = Session.GetDefaultFolder(olFolderCalendar)
    
    For Each currentItem In AppointmentsFolder.Items
        If (currentItem.Class = olAppointment) Then
            Set currentAppointment = currentItem
          
            Call AddToReportIfNotBlank(Report, "BEGIN", "VCALENDAR")
            Call AddToReportIfNotBlank(Report, "BEGIN", "VEVENT")
            Call AddToReportIfNotBlank(Report, "ATTENDEE;CN=", currentAppointment.RequiredAttendees)
            Call AddToReportIfNotBlank(Report, "CLASS", "PRIVATE")
            Call AddToReportIfNotBlank(Report, "CREATED", DateConv(currentAppointment.CreationTime))  '- '18/02/2011 11:48:02
            Call AddToReportIfNotBlank(Report, "DTEND", DateConv(currentAppointment.EndInEndTimeZone)) '- '0110530T080000Z
            Call AddToReportIfNotBlank(Report, "DTSTART", DateConv(currentAppointment.Start)) '- '20110530T070000Z
            Call AddToReportIfNotBlank(Report, "LAST-MODIFIED", DateConv(currentAppointment.LastModificationTime)) '- '20110530T071826Z
            Call AddToReportIfNotBlank(Report, "LOCATION", currentAppointment.Location)
            Call AddToReportIfNotBlank(Report, "ORGANIZER;CN=", currentAppointment.Organizer)
            Call AddToReportIfNotBlank(Report, "SUMMARY;LANGUAGE=en-us", currentAppointment.ConversationTopic)
            Call AddToReportIfNotBlank(Report, "UID", currentAppointment.EntryID)
            Call AddToReportIfNotBlank(Report, "END", "VEVENT")
            Call AddToReportIfNotBlank(Report, "END", "VCALENDAR")
            Report = Report & "--------------------------------------------------------------------------------------------------------"
            Report = Report & vbCrLf & vbCrLf
        End If
    Next
    Call CreateReportAsEmail("List of Appointments", Report)
Exiting:
        Exit Sub
On_Error:
    MsgBox "error=" & Err.Number & " " & Err.Description
    Resume Exiting
End Sub
Private Function AddToReportIfNotBlank(Report As String, FieldName As String, FieldValue)
    AddToReportIfNotBlank = ""
    If (IsNull(FieldValue) Or FieldValue <> "") Then
        AddToReportIfNotBlank = Trim(FieldName & ":" & FieldValue & vbCrLf)
        Report = Report & AddToReportIfNotBlank
    End If
End Function

*-----------------------

Thanks,
Thembani

Posted 5-Jun-11 23:43pm

tembz

Add a Solution

1 solution

Add a Solution

Add your solution here

Treat my content as plain text, not as HTML

Preview 0

…

Existing Members

Sign in to your account

...or Join us

Download, Vote, Comment, Publish.

Your Email
Password
Forgot your password?

Your Email
This email is in use. Do you need your password?
Optional Password

I have read and agree to the Terms of Service and Privacy Policy
Please subscribe me to the CodeProject newsletters

When answering a question please:

Read the question carefully.
Understand that English isn't everyone's first language so be lenient of bad spelling and grammar.
If a question is poorly phrased then either ask for clarification, ignore it, or edit the question and fix the problem. Insults are not welcome.
Don't tell someone to read the manual. Chances are they have and don't get it. Provide an answer or move on to the next question.

Let's work to help developers, not make them feel stupid.

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Kim Togo · Answer 1 · 2011-06-05T23:51:00

Solution 1

You have to use GetSharedDefaultFolder instead of GetDefaultFolder
First create a Recipient via .CreateRecipient

Posted 5-Jun-11 23:51pm

Kim Togo

Comments

tembz 6-Jun-11 6:06am

Thanks Kim. Below is sample code I found from the "help" in Outlook of how to create a Receipient. I ran this and it gives me an error that "A dialog box is open." Find the code attached:

 Private Sub CommandButton1_Click()
    On Error GoTo On_Error
    
    Call ResolveName
    
Exiting:
        Exit Sub
On_Error:
    MsgBox "error=" & Err.Number & " " & Err.Description
    Resume Exiting
    
    End
    
End Sub

Sub ResolveName()
    Dim myNamespace As Outlook.NameSpace
    Dim myRecipient As Outlook.Recipient
    Dim CalendarFolder As Outlook.Folder
    
    Set myNamespace = Application.GetNamespace("MAPI")
    Set myRecipient = myNamespace.CreateRecipient("Thembani Nxumalo")
    myRecipient.Resolve
    If myRecipient.Resolved Then
        Call ShowCalendar(myNamespace, myRecipient)
    End If
End Sub

Sub ShowCalendar(myNamespace, myRecipient)
    Dim CalendarFolder As Outlook.Folder
    Set CalendarFolder = myNamespace.GetSharedDefaultFolder _
        (myRecipient, olFolderCalendar)
        CalendarFolder.Display
End Sub

Kim Togo 6-Jun-11 6:15am

Skip the .Resolve and .Resolved.
In Outlook there is a security in place that prevents 3.party programs to access the Global Contact list.

tembz 6-Jun-11 7:25am

How then do I loop through the list of calendars?

Kim Togo 6-Jun-11 7:36am

You have to know all the calenders you want to access.
See this link: http://www.outlookcode.com/article.aspx?id=52