Submit Hint Search The Forums LinksStatsPollsHeadlinesRSS
14,000 hints and counting!


Click here to return to the 'Use macros' hint
The following comments are owned by whoever posted them. This site is not responsible for what they say.
Use macros
Authored by: jecwobble on Sep 17, '02 08:52:44PM
Here's a couple of VBA scripts I use (linked to custom buttons on Outlook's menubar) to export all my non-recurring calendar events from the current day forward:
Const strFolder = "D:BasiliskOS XvXfer"
Const strBadChar = "~ ! @ # $ % ^ & * ( ) + = { } [ ] |  : ; ' ? /  . ` """

Sub ExportAppointments()
'On Error Resume Next

    Dim olApp As Application
    Dim myNamespace As NameSpace
    Dim fsFolder As MAPIFolder
    Dim olItem As AppointmentItem
    Dim strArray() As String
    Dim intLoop As Integer
    Dim strSubject As String
    
    Set olApp = ThisOutlookSession
    Set myNamespace = olApp.GetNamespace("MAPI")
    Set fsFolder = myNamespace.GetDefaultFolder(olFolderCalendar)
    strArray = Split(strBadChar)
    
    For Each olItem In fsFolder.Items
        With olItem
            If .Start >= Now() And Not .IsRecurring _
              And .Categories  "Holiday" Then
              strSubject = .Subject
                For intLoop = 0 To UBound(strArray)
                    strSubject = Replace(strSubject, strArray(intLoop), "-")
                Next intLoop
                .SaveAs strFolder & strSubject & ".vcs", olVCal
            End If
        End With
    Next olItem
    
    MsgBox "Appointments successfully exported", , "Appointment Export to vCal"
    
End Sub

Sub ExportContacts()
'On Error Resume Next

    Dim olApp As Application
    Dim myNamespace As NameSpace
    Dim fsFolder As MAPIFolder
    Dim olItem As Variant
    Dim intLoop As Integer
    
    Set olApp = ThisOutlookSession
    Set myNamespace = olApp.GetNamespace("MAPI")
    Set fsFolder = myNamespace.GetDefaultFolder(olFolderContacts)
    
    For intLoop = 1 To fsFolder.Items.Count
        Set olItem = fsFolder.Items.Item(intLoop)
        If olItem.Class = olContact Then
            olItem.SaveAs strFolder & olItem.FullName & ".vcf", olVCard
        End If
    Next intLoop
    
    MsgBox "Contacts successfully exported", , "Contact Export to vCard"

End Sub


[ Reply to This | # ]