Link to home
Start Free TrialLog in
Avatar of HalfAndHalf
HalfAndHalf

asked on

Export Calendar Items Programmatically (VBA)

Using the standard menu choices to export a calendar and its associated appointments does not work (some appointments are missing). The commonality is that these are recurring appointments. For example, I have set up a non-terminating recurring daily appointment. Sometimes I change the start/stop time of single occurrences. The export function doesn't always include all appointments.

Is there a VBA-solution to bulletproof export them?
Avatar of David Lee
David Lee
Flag of United States of America image

Hi, HalfAndHalf.

Sure.  What do you want to export too?
Avatar of HalfAndHalf
HalfAndHalf

ASKER

Ultimately, the data will be entered into a database (Access). For now, I'd like to export to a text file and then I can manipulate the data as I see fit.

BTW, the calendar is not the default "CALENDAR"--just another one in the list.
Is CSV ok?
csv is great.
Ok.  Here's the code.  The usage will be:

    ExportFolder OpenOutlookFolder("MailboxName\Folder\SubFolder"), "C:\CalendarExport.csv"

for example

    ExportFolder OpenOutlookFolder("Mailbox - Doe, John\Calendar\My Calendar"), "C:\CalendarExport.csv"

Are you familiar with using Outlook scripts, or do you want more detailed instructions?
Sub ExportFolder(olkFolder As Outlook.MAPIFolder, strFilename As String)
    Dim objFSO As Object, _
        objFile As Object, _
        olkItem As Object, _
        olkProp As Outlook.ItemProperty, _
        bolHeader As Boolean, _
        strHeader As String, _
        strBuffer As String, _
        QT As String
    QT = Chr(34)
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.CreateTextFile(strFilename, True)
    For Each olkItem In olkFolder.items
        For Each olkProp In olkItem.ItemProperties
            If Not olkProp.Type = olOutlookInternal Then
                If Not bolHeader Then
                    strHeader = strHeader & QT & olkProp.Name & QT & ","
                End If
                strBuffer = strBuffer & QT & olkProp.Value & QT & ","
            End If
        Next
        If Not bolHeader Then
            bolHeader = True
            strHeader = Left(strHeader, Len(strHeader) - 1)
            objFile.WriteLine strHeader
            strHeader = ""
        End If
        strBuffer = Left(strBuffer, Len(strBuffer) - 1)
        objFile.WriteLine strBuffer
        strBuffer = ""
    Next
    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    Set olkItem = Nothing
    Set olkProp = Nothing
End Sub
 
Function IsNothing(obj)
  If TypeName(obj) = "Nothing" Then
    IsNothing = True
  Else
    IsNothing = False
  End If
End Function
 
Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
    Dim arrFolders As Variant, _
        varFolder As Variant, _
        olkFolder As Outlook.MAPIFolder
    On Error GoTo ehOpenOutlookFolder
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        If Left(strFolderPath, 1) = "\" Then
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        End If
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            If IsNothing(olkFolder) Then
                Set olkFolder = Session.Folders(varFolder)
            Else
                Set olkFolder = olkFolder.Folders(varFolder)
            End If
        Next
        Set OpenOutlookFolder = olkFolder
    End If
    On Error GoTo 0
    Exit Function
ehOpenOutlookFolder:
    Set OpenOutlookFolder = Nothing
    On Error GoTo 0
End Function

Open in new window

Good morning BlueDevil,

Thanks for the immediate attention to this. The code runs but the individual instances of the daily recurring appointments didn't get captured. For example, I created a recurring appointment called "Attendance" which goes from 9am to 5pm. (No! I am not a 9-5er ;)) This runs M-F. (ditto).

Somedays, I change the individual occurrence to, say, 7am to 6pm. I want to be able to export for each day as shown in the calendar layout the appointments that appear on screen into a csv file. The program merely outputted the global settings of the series rather than each individual occurrence.

Any ideas?

Thanks a lot.
HalfAndHalf,

I haven't forgotten about this question.  I was traveling with no internet connection.  I'll have a look at this tomorrow.
ASKER CERTIFIED SOLUTION
Avatar of David Lee
David Lee
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thank you for sticking with this. I appreciate your assistance.
You're welcome.  Sorry I was slow in spots.
Hi,

I know this has an accepted solution, but I have the same issue, and am not sure how to implement your script, are you able to elaborate? :)

Cheers

Tom
Hi, Tom.

Follow these instructions to use the code.
  1. Start Outlook.
  2. Click Tools->Macro->Visual Basic Editor.
  3. If not already expanded, expand Modules and click on Module1.
  4. Copy the  code above and below and paste it into the right-hand pane of the VB Editor.
  5. Edit  the code as desired.  I placed a comment line where things can/need to change
  6. Click the diskette icon on the toolbar to save the  changes.
  7. Close the VB Editor.
  8. Click  Tools->Macro->Security.
  9. Change the Security Level setting to  Medium.
  10. Run the macro (Tools->Macro->Macros).
Sub RunExport()
    'Change the file name and path, and the starting/ending dates/times on the next line
    ExportCalendar Session.GetDefaultFolder(olFolderCalendar), "C:\eeTesting\Calendar.csv", #7/1/2008 12:01:00 AM#, #7/30/2008 11:59:00 PM#
End Sub

Open in new window