Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17


Export Outlook Calendar Items via VBA with Recurrences

Posted on 2008-06-10
Medium Priority
Last Modified: 2010-04-21

Firstly, I'll outline what I am trying to do and then what I have achieved so far and the problems encountered

I need a quick 'n' dirty solution to export Calendar Items from Public Folders using Outlook 2000 from Exchange 5.5. My client's server is so old and is going to die *soon* and there is limited backup facilities. Data backup is being affected using a network copy to a more stable machine. Problem is backing up Exchange...

There are approximately 15 Calendars in the Public Folders which need to be backed up. Some of these calendars have recurring appointments and must be re-established for legal implications. Now, I have found some code that will export Calendar Items to a CSV file (Q_22448259) and have managed to pick up the 'IsRecurring' property...but when you try to import the file and map the fields, there is no recurrence item or pattern available

Also, the is some help in Outlook VBA in 'GetRecurrencePattern Method' which allows you to obtain the recurrence pattern and dates etc, but it seems involved if there are more than one type of recurrence

OK...question is...have I missed something i.e. is there an easier way of doing this?
For example - Get a list of all the Calendars in Public Folders & spit out each Calendar in turn to a PST file of the same name?

Unfortunately, time is of the essence and also the prog will become redundant when the new server goes in. I appreciate this could be achieved manually but I am concious of user error. Also, the project is sufficiently large enough with many other potential pitfalls, I do not have the time to really dedicate to making a nice solution quickly

Any help/ideas would be most graciously received

Question by:eric_fusebox
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 6
LVL 76

Expert Comment

by:David Lee
ID: 21762894
Hi, eric_fusebox.

Why do you need to use VBA to do this?  Why not simply copy the calendars to a PST file?

Author Comment

ID: 21767749
"I appreciate this could be achieved manually but I am concious of user error..."

There are over 15 calendars to backup (more likely 20+). With the level of user knowledge within the firm, I am not confident that this task could be performed correctly each night. I could, of course, use remote access and do it myself...but surely the below is possible?

"For example - Get a list of all the Calendars in Public Folders & spit out each Calendar in turn to a PST file of the same name?"

I have extensively trolled the internet for code alluding to such, but to no avail.
LVL 76

Expert Comment

by:David Lee
ID: 21767827
Understood.  I didn't realize that this would be an ongoing process.  I thought the intent was to back up the folders once in preparation for a move to something else before the impending server failure.  Does the backup have to be to CSV or would backing up to a PST work?
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.


Author Comment

ID: 21768894
No probs - there is impending server failure but 100-150 items could be added daily(!)

I can export as CSV - but it does not handle *recurring* items. It will report whether or not the item has a recurrence i.e. it reports 'IsRecurrence'=TRUE but it does not report the recurrence pattern i.e. daily at 1300 etc

The attached code is from the 'GetRecurrence Method Example' in VBA Help which will retrieve the recurrence detail for a specific item...but all seems a bit long winded and unecessary if you can export directly to a PST which would be ideal. Have trolled internet for exporting Public Folders to PST unsing VBA but I cannot find *anything*

Public Sub cmdExample()
    Dim myOlApp As Outlook.Application
    Dim myApptItem As Outlook.AppointmentItem
    Dim myRecurrPatt As Outlook.RecurrencePattern
    Dim myNamespace As Outlook.NameSpace
    Dim myFolder As Outlook.MAPIFolder
    Dim myItems As Outlook.Items
    Dim myDate As Date
    Dim myOddApptItem As Outlook.AppointmentItem
    Dim saveSubject As String
    Dim newDate As Date
    Dim myException As Outlook.Exception
    Set myOlApp = New Outlook.Application
    Set myApptItem = myOlApp.CreateItem(olAppointmentItem)
    myApptItem.Start = #2/2/2003 3:00:00 PM#
    myApptItem.End = #2/2/2003 4:00:00 PM#
    myApptItem.Subject = "Meet with Boss"
    'Get the recurrence pattern for this appointment
    'and set it so that this is a daily appointment
    'that begins on 2/2/03 and ends on 2/2/04
    'and save it.
    Set myRecurrPatt = myApptItem.GetRecurrencePattern
    myRecurrPatt.RecurrenceType = olRecursDaily
    myRecurrPatt.PatternStartDate = #2/2/2003#
    myRecurrPatt.PatternEndDate = #2/2/2004#
    'Access the items in the Calendar folder to locate
    'the master AppointmentItem for the new series.
    Set myNamespace = myOlApp.GetNamespace("MAPI")
    Set myFolder = myNamespace.GetDefaultFolder(olFolderCalendar)
    Set myItems = myFolder.Items
    Set myApptItem = myItems("Meet with Boss")
    'Get the recurrence pattern for this appointment
    'and obtain the occurrence for 3/12/03.
    myDate = #3/12/2003 3:00:00 PM#
    Set myRecurrPatt = myApptItem.GetRecurrencePattern
    Set myOddApptItem = myRecurrPatt.GetOccurrence(myDate)
    'Save the existing subject. Change the subject and
    'starting time for this particular appointment
    'and save it.
    saveSubject = myOddApptItem.Subject
    myOddApptItem.Subject = "Meet NEW Boss"
    newDate = #3/12/2003 3:30:00 PM#
    myOddApptItem.Start = newDate
    'Get the recurrence pattern for the master
    'AppointmentItem. Access the collection of
    'exceptions to the regular appointments.
    Set myRecurrPatt = myApptItem.GetRecurrencePattern
    Set myException = myRecurrPatt.Exceptions.Item(1)
    'Display the original date, time, and subject
    'for this exception.
    MsgBox myException.OriginalDate & ": " & saveSubject
    'Display the current date, time, and subject
    'for this exception.
    MsgBox myException.AppointmentItem.Start & ": " & _
End Sub

Open in new window

LVL 76

Expert Comment

by:David Lee
ID: 21770105
It's simple enough to do.  I have a code snippet somewhere that does it.  I'll have to find it.  Back as soon as I've done that.

Author Comment

ID: 21780689
OK. That would be great! Thanks!
LVL 76

Accepted Solution

David Lee earned 2000 total points
ID: 21798973
Ok, this should do it.  Follow these instructions to use this.

1.  Start Outlook
2.  Click Tools->Macro->Visual Basic Editor
3.  If not already expanded, expand Microsoft Office Outlook Objects and click on Module1
4.  Copy the code below and paste it into the right-hand pane of the VB Editor window
5.  Edit the code per the comments I included in it
6.  Click the diskette icon on the toolbar to save the changes
7.  Close the VB Editor
8.  Click Tools->Macro->Security
9.  Set the Security Level to Medium
10. Run the macro RunBackups whenever you want to run a backup.
Sub RunBackups()
    'Add a line like the one below for each folder you want to back up
    BackupFolderToPSTFile "Public Folders\All Public Folders\Some Folder"
End Sub
Sub BackupFolderToPSTFile(strSourcePath As String)
    'Change the path on the following line to your path
    Const BACKUP_PATH = "C:\eeTesting\Backups\"
    Dim strBackupFileName As String, _
        objFSO As Object, _
        olkApp As Outlook.Application, _
        olkFolder As Outlook.MAPIFolder, _
        olkFolderCopy As Outlook.MAPIFolder, _
        olkBackup As Outlook.MAPIFolder
    strBackupFileName = "BU " & Format(Time, "hhmm") & "_" & Format(Date, "dd mmm yyyy") & ".pst"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If objFSO.FileExists(BACKUP_PATH & strBackupFileName) Then
        MsgBox "The folder was already backed up within the last minute.", vbInformation + vbOKOnly, "Folder BackUp"
        Set olkApp = CreateObject("Outlook.Application")
        olkApp.Session.AddStore BACKUP_PATH & strBackupFileName
        Set olkBackup = OpenOutlookFolder("Personal Folders")
        olkBackup.Name = strBackupFileName
        olkApp.Session.RemoveStore olkBackup
        olkApp.Session.AddStore BACKUP_PATH & strBackupFileName
        Set olkBackup = OpenOutlookFolder(strBackupFileName)
        Set olkFolder = OpenOutlookFolder(strSourcePath)
        Set olkFolderCopy = olkFolder.CopyTo(olkBackup)
        olkApp.Session.RemoveStore olkBackup
    End If
    Set objFSO = Nothing
    Set olApp = Nothing
    Set olkBackup = Nothing
    Set olkFolder = Nothing
    Set olkFolderCopy = Nothing
End Sub
Function IsNothing(obj)
  If TypeName(obj) = "Nothing" Then
    IsNothing = True
    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
        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)
                Set olkFolder = olkFolder.Folders(varFolder)
            End If
        Set OpenOutlookFolder = olkFolder
    End If
    On Error GoTo 0
    Exit Function
    Set OpenOutlookFolder = Nothing
    On Error GoTo 0
End Function

Open in new window


Author Comment

ID: 21800339
That's great! Will test this ASAP and get right back as soon as I have done so (Wednesday). Many thanks in advance
LVL 76

Expert Comment

by:David Lee
ID: 21801258
No problem.  I'll be here.

Author Comment

ID: 21820394
Many, many thanks! It works a treat and I'll be able to configure for my own needs. Thanks for your help - very much appreciated

Author Closing Comment

ID: 31465733
Many, many thanks - very much appreciated
LVL 76

Expert Comment

by:David Lee
ID: 21820774
You're welcome!  Glad I could help out.

Featured Post

Learn Veeam advantages over legacy backup

Every day, more and more legacy backup customers switch to Veeam. Technologies designed for the client-server era cannot restore any IT service running in the hybrid cloud within seconds. Learn top Veeam advantages over legacy backup and get Veeam for the price of your renewal

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you troubleshoot Outlook for clients, you may want to know a bit more about the OST file before doing your next job. IMAP can cause a lot of drama if removed in the accounts without backing up.
Check out this step-by-step guide for using the newly updated Experts Exchange mobile app—released on May 30.
To show how to create a transport rule in Exchange 2013. We show this process by using the Exchange Admin Center. Log into Exchange Admin Center.: First we need to log into the Exchange Admin Center. Navigate to the Mail Flow >> Rules tab.:  To cr…
This video discusses moving either the default database or any database to a new volume.
Suggested Courses

721 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question