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.
*-----------------------
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))
Call AddToReportIfNotBlank(Report, "DTEND", DateConv(currentAppointment.EndInEndTimeZone))
Call AddToReportIfNotBlank(Report, "DTSTART", DateConv(currentAppointment.Start))
Call AddToReportIfNotBlank(Report, "LAST-MODIFIED", DateConv(currentAppointment.LastModificationTime))
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