Code to send Outlook 2003 shared calendar information to Excel spreadsheet

Question

I've been trying to cobble together some code to send all the information in our calendar to an Excel file. I work on a multi-site shared network and the calendars are shared generally with everyone that needs access to them from a shared company mailbox.

I have found guides on how to do this from local calendars and from calendars shared between two people, but I'm struggling to get it to work on our system.

Here is the code I am using:

 Sub RunExportCalendarsToExcel()
    'Change the name of the conference room on the next line.  The name must match the name of the mailbox.'
    ExportCalendarToExcel "County, Family", True
End Sub

Sub ExportCalendarToExcel(strCalendarName As String, Optional bolClearWorksheet As Boolean)
    Dim olkFolder As Outlook.Folder, olkItems As Outlook.Items, olkAppt As Outlook.AppointmentItem, olkRecipient As Outlook.Recipient
    Dim excApp As Object, excWkb As Object, excSht As Object, excRng As Object, lngRow As Long
    Dim arrTitle As Variant

    'Launch Excel and open the spreadsheet'
    Set excApp = CreateObject("Excel.Application")
    excApp.Visible = True
    'Change the name and path of the spreadsheet on the next line'
    Set excWkb = excApp.Workbooks.Open("\\dom1\data\County\Wolverhampton\Home\[my username]\List.xls")
    Set excSht = excWkb.Worksheets(1)
    If bolClearWorksheet Then
        Set excRng = excSht.Range("A1").CurrentRegion
        lngRow = excRng.Rows.Count
        excApp.Rows(2 & ":" & lngRow).Delete
        lngRow = 2
    Else
        lngRow = excSht.UsedRange.Rows.Count + 1
    End If

   'Connect to and process the shared calendar'
    Set olkRecipient = Session.CreateRecipient(strCalendarName)
    Set olkFolder = Session.GetSharedDefaultFolder(olkRecipient, olFolderCalendar)
    datDate = InputBox("Enter the date you want to export for.", "Export Calendars to Excel", Date)
    Set olkItems = olkFolder.Items.Restrict("[Start] >= '" & Format(datDate & " 0:01am", "ddddd h:nn AMPM") & "' AND [Start] < '" & Format(datDate & " 11:59pm", "ddddd h:nn AMPM") & "'")
    olkItems.Sort "[Start]"
    olkItems.IncludeRecurrences = True
    For Each olkAppt In olkItems
        arrTitle = Split(olkAppt.Subject, "-")
        excSht.Cells(lngRow, 1) = olkAppt.Start
        excSht.Cells(lngRow, 2) = olkAppt.End
        excSht.Cells(lngRow, 3) = strCalendarName
        excSht.Cells(lngRow, 4) = olkAppt.Organizer
        excSht.Cells(lngRow, 5) = olkAppt.Body
        lngRow = lngRow + 1
    Next

    'Save the spreadsheet and exit Excel'
    Set excRng = Nothing
    Set excSht = Nothing
    excWkb.Save
    Set excWkb = Nothing
    excApp.Quit
    Set excApp = Nothing

    'Clean-up the Outlook objects'
    Set olkFolder = Nothing
    Set olkItems = Nothing
    Set olkAppt = Nothing
End Sub

There are three calendars with appointments scheduled at different times throughout the day between 9AM and 5PM.

No matter what I do, I keep getting the error 'User-defined type not defined' at this line, with 'Dim olkFolder as Outlook.Folder' highlighted as if it is selected:

Sub ExportCalendarToExcel(strCalendarName As String, Optional bolClearWorksheet As Boolean)
Dim olkFolder As Outlook.Folder, olkItems As Outlook.Items, olkAppt As Outlook.AppointmentItem, olkRecipient As Outlook.Recipient

I've only been writing in VBA for a few months, so please let me know if there is any other information you need that I haven't given.

Answer 1

2003 Outlook 对象模型使用 MAPIFolder 作为对象名称，而不是 Folder - 这是在更高版本中引入的（向后兼容 MAPIFolder 的用法）。