Process All Outlook Events

I recently needed to walk through all the events in an Outlook calendar and make a change. Here is the simple code:

' Copyright under GPL by Mark Grimes
' list folders by poping up msg box windows
Sub ResaveCalendarEntries()

    Dim objNS As NameSpace
    Dim objFolders, objFolder, objCalFolder
    Dim objCalEntry As AppointmentItem

    Dim count
    count = 0

    Set objNS = Application.GetNamespace("MAPI")
    Set objCalFolder = objNS.Folders.item("Mailbox - MyMailBox").Folders.item("Calendar")
    ' This also works...
    ' Set objCalFolder = objNS.GetDefaultFolder(olFolderCalendar)

    For Each objCalEntry In objCalFolder.Items
        count = count + 1
        Debug.Print count
        Debug.Print objCalEntry.Subject

        objCalEntry.Mileage = 1
        objCalEntry.Save
        ' Exit Sub
    Next
    Set objNS = Nothing

End Sub