Outlook VBA agenda

In dit artikel komt aan de orde hoe afspraken m.b.v. VBA gemaakt en weer verwijderd kunnen worden in een Outlook agenda. De handelingen vinden plaats in een specifieke agenda en de afspraken kenmerken zich met een specifieke categorie. Op deze manier kan de agenda voor één specifiek doel worden ingezet en blijven de - handmatig aangemaakte - afspraken onaangetast.

Om dit alles mogelijk te maken is de onderstaande klassenmodule - gebaseerd op een vroege binding - ontwikkeld met twee procedures, te weten: maakAfspraken en verwijderAfspraken. Door eerst de procedure verwijderAfspraken uit te voeren en daarna de procedure maakAfspraken kan deze klassenmodule worden ingezet voor bijvoorbeeld het uploaden van afspraken uit Excel naar een agenda van Outlook.

Deze techniek is vele malen efficiënter dan een routine te ontwikkelen die afspraken synchroniseert.

Class_Initialize

Hier worden alle objecten geladen en de betreffende agenda geselecteerd m.b.v. de opgegeven naam. Om i.p.v. een specifieke agenda te gebruiken kan ook de standaard agenda worden gebruikt:

Set objAgenda = objNameSpace.GetDefaultFolder(olFolderCalendar)

maakAfspraken

In deze procedure worden drie afspraken toegevoegd met een interval van 1 week, beginnend vanaf vandaag. Elke afspraak krijgt de opgegeven categorie.

verwijderAfspraken

In deze procedure worden alle afspraken weer verwijderd met de opgegeven categorie. Gezien tijdens het verwijderen telkens het totale aantal te verwijderen afspraken wijzigt, wordt er van achter naar voor gewerkt. Dit is iets wat met een for-each loop niet kan worden bewerkstelligd.

Class_Terminate

Tot slot worden alle geladen objecten weer uit het geheugen gehaald.

Option Explicit

Dim objOutlook As Outlook.Application
Dim objNameSpace As Outlook.Namespace
Dim objAgenda As Outlook.MAPIFolder
Dim objAfspraak As Outlook.AppointmentItem

Const strAgenda = "NaamAgenda"
Const strCategorie = "NaamCategorie"

Private Sub Class_Initialize()

    Set objOutlook = Outlook.Application
    Set objNameSpace = objOutlook.GetNamespace("MAPI")
    Set objAgenda = objNameSpace.GetDefaultFolder(olFolderCalendar).Folders(strAgenda)

End Sub

Sub maakAfspraken()

    Dim i As Integer
    Dim d As Date
    
    d = Date
    
    For i = 1 To 3
    
        Set objAfspraak = objAgenda.Items.Add
        
        With objAfspraak
            .Start = d
            .AllDayEvent = True
            .Subject = "Afspraak " & i
            .Body = "Body"
            .Categories = strCategorie
            .Save
        End With
    
        Set objAfspraak = Nothing
        
        d = DateAdd("ww", 1, d)
    
    Next i

End Sub

Sub verwijderAfspraken()

    Dim i As Integer

    For i = objAgenda.Items.Count To 1 Step -1
        Set objAfspraak = objAgenda.Items(i)
        If objAfspraak.Categories = strCategorie Then objAfspraak.Delete
    Next i

End Sub

Private Sub Class_Terminate()

    Set objOutlook = Nothing
    Set objNameSpace = Nothing
    Set objAgenda = Nothing

End Sub

Terugkerende afspraak

De onderstaande procedure maakt een afspraak aan met de huidige datum en tijd. Voorts is er sprake van een terugkerende afspraak om de 3 weken. Deze afspraak duurt 30 minuten en kent geen einddatum.

Deze procedure staat los van de bovenstaande klassenmodule en maakt gebruik van de standaard agenda.

Option Explicit

Sub maakTerugkerendeAfspraak()
    
    Dim objOutlook As Outlook.Application
    Dim objAfspraak As Outlook.AppointmentItem
    Dim objNameSpace As Outlook.Namespace
    Dim objTerugkerendPatroon As Outlook.RecurrencePattern
    Dim objAgenda As Outlook.MAPIFolder

    Set objOutlook = Outlook.Application
    Set objNameSpace = objOutlook.GetNamespace("MAPI")
    Set objAgenda = objNameSpace.GetDefaultFolder(olFolderCalendar)
    Set objAfspraak = objAgenda.Items.Add
    Set objTerugkerendPatroon = objAfspraak.GetRecurrencePattern
 
    With objAfspraak
        .Subject = "Onderwerp"
        .Body = "Body"
        .Location = "Locatie"
        .Categories = "Categorie"
    End With

    With objTerugkerendPatroon

        .RecurrenceType = olRecursWeekly
        .Interval = 3
        .PatternStartDate = Date
        .StartTime = Time
        .Duration = 30
        .NoEndDate = True
        
        Select Case Weekday(Date, vbMonday)
            Case Is = 1 'maandag
                .DayOfWeekMask = 2
            Case Is = 2 'dinsdag
                .DayOfWeekMask = 4
            Case Is = 3 'woensdag
                .DayOfWeekMask = 8
            Case Is = 4 'donderdag
                .DayOfWeekMask = 16
            Case Is = 5 'vrijdag
                .DayOfWeekMask = 32
            Case Is = 6 'zaterdag
                .DayOfWeekMask = 64
            Case Is = 7 'zondag
                .DayOfWeekMask = 1
        End Select

    End With

    objAfspraak.Save
    
    Set objTerugkerendPatroon = Nothing
    Set objAfspraak = Nothing
    Set objNameSpace = Nothing
    Set objAgenda = Nothing
    Set objOutlook = Nothing
    
End Sub