Solved

Export Outlook Calendar Items via VBA with Recurrences

Posted on 2008-06-10
12
2,022 Views
Last Modified: 2010-04-21
Hi!

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

Regards
Steve
0
Comment
Question by:eric_fusebox
[X]
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
12 Comments
 
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?
0
 

Author Comment

by:eric_fusebox
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.
0
 
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?
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:eric_fusebox
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#
    myApptItem.Save
    
    '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
    myOddApptItem.Save
    
    '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 & ": " & _
    myException.AppointmentItem.Subject
End Sub

Open in new window

0
 
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.
0
 

Author Comment

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

Accepted Solution

by:
David Lee earned 500 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"
    Else
        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
  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

0
 

Author Comment

by:eric_fusebox
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
0
 
LVL 76

Expert Comment

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

Author Comment

by:eric_fusebox
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
0
 

Author Closing Comment

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

Expert Comment

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

Featured Post

Free eBook: Backup on AWS

Everything you need to know about backup and disaster recovery with AWS, for FREE!

Question has a verified solution.

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

This article explains how to install and use the NTBackup utility that comes with Windows Server.
A list of top three free exchange EDB viewers that helps the user to extract a mailbox from an unmounted .edb file and get a clear preview of all emails & other items with just a single click on mailboxes.
In this video we show how to create a mailbox database 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 Servers >> Data‚Ķ
To show how to generate a certificate request 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 Servers >> Certificates‚Ķ

726 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