W
WD
I have a VBA code in Excel that I use to extract calendar information from my
calendar to an Excel sheet. I would like to extract from a public calendar
instead. Is this possible? and if yes, what changes would I need to make to
the code below to do that. Any assistance would be helpful. Thanks
Private Sub GetMeetings_Click()
Dim ol As New Outlook.Application
Dim ns As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim appts As Object
Dim appt As Object
Dim date1 As Date, date2 As Date
Dim i As Integer
Set ns = ol.GetNamespace("MAPI")
Set olFolder = ns.GetDefaultFolder(olFolderCalendar)
Set appts = olFolder.Items
date1 = InputBox("Starting Date: ", "Start Date")
date2 = InputBox("End Date: ", "End Date")
i = 2
For Each appt In appts
If appt.Start >= date1 And appt.Start < date2 Then
Sheets("rawdata").Cells(i, 2).Value = appt.ConversationTopic
Sheets("rawdata").Cells(i, 4).Value = Format(appt.Start, "short date")
Sheets("rawdata").Cells(i, 5).Value = Format(appt.Start, "medium
time")
Sheets("rawdata").Cells(i, 6).Value = Format(appt.End, "medium time")
Sheets("rawdata").Cells(i, 7).Value = appt.Location
Sheets("rawdata").Cells(i, 3).Value = appt.Organizer
Sheets("rawdata").Cells(i, 8).Value = appt.Body
Sheets("rawdata").Cells(i, 9).Value = appt.RequiredAttendees
Sheets("rawdata").Cells(i, 10).Value = appt.OptionalAttendees
i = i + 1
End If
Next appt
Set ol = Nothing
Set ns = Nothing
Set appt = Nothing
End Sub
calendar to an Excel sheet. I would like to extract from a public calendar
instead. Is this possible? and if yes, what changes would I need to make to
the code below to do that. Any assistance would be helpful. Thanks
Private Sub GetMeetings_Click()
Dim ol As New Outlook.Application
Dim ns As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim appts As Object
Dim appt As Object
Dim date1 As Date, date2 As Date
Dim i As Integer
Set ns = ol.GetNamespace("MAPI")
Set olFolder = ns.GetDefaultFolder(olFolderCalendar)
Set appts = olFolder.Items
date1 = InputBox("Starting Date: ", "Start Date")
date2 = InputBox("End Date: ", "End Date")
i = 2
For Each appt In appts
If appt.Start >= date1 And appt.Start < date2 Then
Sheets("rawdata").Cells(i, 2).Value = appt.ConversationTopic
Sheets("rawdata").Cells(i, 4).Value = Format(appt.Start, "short date")
Sheets("rawdata").Cells(i, 5).Value = Format(appt.Start, "medium
time")
Sheets("rawdata").Cells(i, 6).Value = Format(appt.End, "medium time")
Sheets("rawdata").Cells(i, 7).Value = appt.Location
Sheets("rawdata").Cells(i, 3).Value = appt.Organizer
Sheets("rawdata").Cells(i, 8).Value = appt.Body
Sheets("rawdata").Cells(i, 9).Value = appt.RequiredAttendees
Sheets("rawdata").Cells(i, 10).Value = appt.OptionalAttendees
i = i + 1
End If
Next appt
Set ol = Nothing
Set ns = Nothing
Set appt = Nothing
End Sub