Durchsuchen des Kalenders nach Terminen innerhalb eines Datumsbereichs, die ein bestimmtes Wort im Betreff enthalten

In diesem Thema wird ein Codebeispiel in Visual Basic für Applikationen (VBA) gezeigt, das Termine im Standardkalender sucht, die exakt innerhalb der nächsten dreißig Tage liegen und die das Wort "team" im Betreff enthalten. Die zurückgegebenen Ergebnisse umfassen auch Terminserien.

Die FindAppts Funktion im Codebeispiel führt die Suche mithilfe von zwei verschiedenen Abfragen aus: zuerst nach Terminen, einschließlich Terminserien, die innerhalb des Datumsbereichs beginnen und enden, und dann nach Terminen, die die Datumsbereichskriterien erfüllen, die "Team" im Betreff enthalten. Im Folgenden werden die Schritte beschrieben:

1. FindAppts definiert zuerst den Zeitraum für die Abfrage und weist die Startzeit ( myStart) als 12:00 Uhr am aktuellen Systemdatum und die Endzeit als myEnddreißig Tage nach der Startzeit zu.

2. Die Funktion ruft alle Elemente im Standardkalenderordner ab.

3. Damit in der Abfrage Terminserien berücksichtigt werden, wird Items.IncludeRecurrences auf True festgelegt und die Elemente dann nach der AppointmentItem.Start -Eigenschaft sortiert.

4. Es erstellt die erste Abfrage für alle Termine, die mit oder nach myStartbeginnen und auf oder vor myEndenden. Diese Abfrage ist eine Jet-Abfrage.

5. Danach wird die Abfrage auf Elemente im Standardkalenderordner angewendet, indem die Items.Restrict -Methode verwendet wird.

6. Die zweite Abfrage nach den Terminbetreffs mit dem Wort "team" wird erstellt. Es verwendet das Schlüsselwort für den like Teilzeichenfolgenabgleich in einer DASL-Abfrage (DAV Searching and Locating).

7. Die zweite Abfrage wird nun auf den Satz von Terminen angewendet, der die Datenbereichskriterien erfüllt und von der ersten Abfrage zurückgegeben wurde.

8. Die Startzeit aller endgültig zurückgegebenen Termine wird sortiert und ausgegeben.

Wenn Sie Terminelemente einschließen möchten, die sich überschneiden und nicht streng innerhalb des bestimmten Datumsbereichs liegen, sollten Sie die erste Abfrage in eine Abfrage ändern, bei der Termine mit oder vor myEndbeginnen und auf oder nach myStartenden. Weitere Informationen finden Sie unterVorgehensweise: Durchsuchen des Kalenders nach Terminen, die teilweise oder vollständig in einem festgelegten Zeitraum liegen.

Sub FindAppts()

    Dim myStart As Date
    Dim myEnd As Date
    Dim oCalendar As Outlook.folder
    Dim oItems As Outlook.items
    Dim oItemsInDateRange As Outlook.items
    Dim oFinalItems As Outlook.items
    Dim oAppt As Outlook.AppointmentItem
    Dim strRestriction As String

    myStart = Date
    myEnd = DateAdd("d", 30, myStart)

    Debug.Print "Start:", myStart
    Debug.Print "End:", myEnd
          
    'Construct filter for the next 30-day date range
    strRestriction = "[Start] >= '" & _
    Format$(myStart, "mm/dd/yyyy hh:mm AMPM") _
    & "' AND [End] <= '" & _
    Format$(myEnd, "mm/dd/yyyy hh:mm AMPM") & "'"
    'Check the restriction string
    Debug.Print strRestriction
    Set oCalendar = Application.session.GetDefaultFolder(olFolderCalendar)
    Set oItems = oCalendar.items
    oItems.IncludeRecurrences = True
    oItems.Sort "[Start]"
    'Restrict the Items collection for the 30-day date range
    Set oItemsInDateRange = oItems.Restrict(strRestriction)
    'Construct filter for Subject containing 'team'
    Const PropTag  As String = "https://schemas.microsoft.com/mapi/proptag/"
    strRestriction = "@SQL=" & Chr(34) & PropTag _
        & "0x0037001E" & Chr(34) & " like '%team%'"
    'Restrict the last set of filtered items for the subject
    Set oFinalItems = oItemsInDateRange.Restrict(strRestriction)
    'Sort and Debug.Print final results
    oFinalItems.Sort "[Start]"
    For Each oAppt In oFinalItems
        Debug.Print oAppt.Start, oAppt.Subject
    Next
End Sub

Support und Feedback

Haben Sie Fragen oder Feedback zu Office VBA oder zu dieser Dokumentation? Unter Office VBA-Support und Feedback finden Sie Hilfestellung zu den Möglichkeiten, wie Sie Support erhalten und Feedback abgeben können.