Solved

Export Outlook Calendar Items via VBA with Recurrences

Posted on 2008-06-10
12
1,926 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
  • 6
  • 6
12 Comments
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
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
Comment Utility
"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
Comment Utility
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
 

Author Comment

by:eric_fusebox
Comment Utility
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
Comment Utility
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
Comment Utility
OK. That would be great! Thanks!
0
Promote certifications in your email signature

Has your company recently won an award or achieved a certification? They'll no doubt want to show it off. Email signature images used to promote certifications & awards can instantly establish credibility with a recipient and provide you with numerous benefits.

 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
Comment Utility
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
Comment Utility
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
Comment Utility
No problem.  I'll be here.
0
 

Author Comment

by:eric_fusebox
Comment Utility
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
Comment Utility
Many, many thanks - very much appreciated
0
 
LVL 76

Expert Comment

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

Featured Post

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Join & Write a Comment

Resolve DNS query failed errors for Exchange
Scam emails are a huge burden for many businesses. Spotting one is not always easy. Follow our tips to identify if an email you receive is a scam.
In this video we show how to create a User Mailbox 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 Recipients >> Mailb…
In this video we show how to create an email address policy 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…

728 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

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now