Hoe u de lijst met alle drukke afspraken in een specifiek datumbereik kunt afdrukken via Outlook VBA

Dit artikel leert u een eenvoudige methode om de lijst af te drukken met alle afspraken die worden weergegeven als 'Bezet' en die in een specifiek datumbereik zijn gepland.

Het is vrij eenvoudig om alle agenda's te doorlopen en alle bezette afspraken binnen een specifiek datumbereik te vinden. Stel het zoekbereik in op 'Alle agenda-items'. Zoek vervolgens naar afspraken waarbij 'Tijd weergeven als' gelijk is aan 'Bezet' en binnen de opgegeven begin- en einddatum vallen. Wanneer u echter de gevonden afspraken wilt afdrukken via 'Bestand' > 'Afdrukken', ziet u dat alleen de optie 'Memostijl' beschikbaar is. Dit betekent dat u de gevonden afspraken niet als lijst kunt afdrukken. Wilt u de lijst met deze afspraken wel afdrukken, dan kunt u de volgende methode gebruiken.

Druk de lijst af met alle drukke afspraken in een specifiek datumbereik

1. Start vanaf het begin de Outlook VBA-editor via "Alt + F11".
2. Voeg vervolgens in het pop-upvenster "Microsoft Visual Basic for Applications" de verwijzing naar "MS Excel Object Library" toe, zoals aangegeven.Hoe voeg je een verwijzing naar een objectbibliotheek toe in VBA?'.
3. Plaats daarna de volgende VBA-code in een module.

Dim dStart, dEnd As Date
Dim objExcelApp As Excel.Application
Dim objExcelWorkbook As Excel.Workbook
Dim objExcelWorksheet As Excel.Worksheet

Sub PrintListOfAllBusyAppointments()
    Dim objStore As Store
    Dim objFolder As Folder
 
    dStart = InputBox("Enter the start date:", , Date)
    dEnd = InputBox("Enter the end date:", , Date + 30)
 
    Set objExcelApp = CreateObject("Excel.Application")
    Set objExcelWorkbook = objExcelApp.Workbooks.Add
    Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
    objExcelApp.Visible = True
 
    With objExcelWorksheet
         .Cells(1, 1) = "Subject"
         .Cells(1, 1).Font.Bold = True
         .Cells(1, 2) = "Location"
         .Cells(1, 2).Font.Bold = True
         .Cells(1, 3) = "Start"
         .Cells(1, 3).Font.Bold = True
         .Cells(1, 4) = "End"
         .Cells(1, 4).Font.Bold = True
         .Cells(1, 5) = "In Folder"
         .Cells(1, 5).Font.Bold = True
    End With
 
    For Each objStore In Application.Session.Stores
        For Each objFolder In objStore.GetRootFolder.Folders
            If objFolder.DefaultItemType = olAppointmentItem Then
               Call ProcessFolders(objFolder)
            End If
        Next
    Next
 
    objExcelWorksheet.Columns("A:E").AutoFit
    objExcelWorksheet.PrintOut
    objExcelWorkbook.Close False
    objExcelApp.Quit
End Sub

Sub ProcessFolders(ByVal objCurFolder As Folder)
    Dim strFilter As String
    Dim objItems As Outlook.Items
    Dim objRestrictedItems As Outlook.Items
    Dim objAppointment As AppointmentItem
    Dim nLastRow As Integer
    Dim objSubFolder As Folder
 
    Set objItems = objCurFolder.Items
    objItems.IncludeRecurrences = True
    objItems.Sort "[Start]"
 
    'Get the appointments in the specific date range
    strFilter = "[Start] >= " & Chr(34) & dStart & " 00:00 AM" & Chr(34) & " AND [End] <= " & Chr(34) & dEnd & " 11:59 PM" & Chr(34)
    Set objRestrictedItems = objItems.Restrict(strFilter)

    For Each objAppointment In objRestrictedItems
        If objAppointment.BusyStatus = olBusy Then
           nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1
 
           With objExcelWorksheet
                .Range("A" & nLastRow) = objAppointment.Subject
                .Range("B" & nLastRow) = objAppointment.Location
                .Range("C" & nLastRow) = objAppointment.Start
                .Range("D" & nLastRow) = objAppointment.End
                .Range("E" & nLastRow) = objCurFolder.FolderPath
           End With
        End If
    Next

    'Process all subfolders recursively
    If objCurFolder.Folders.Count > 0 Then
       For Each objSubFolder In objCurFolder.Folders
           Call ProcessFolders(objSubFolder)
       Next
    End If
End Sub

4. Klik later in de eerste subroutine en druk op de “F5”-toets.
5. Vervolgens moet u het datumbereik opgeven voor het zoeken naar afspraken.
6. Klik vervolgens op “OK” om door te gaan met de macro.
7. Als de macro ten slotte is voltooid, wordt de lijst met drukke afspraken in het vooraf gedefinieerde datumbereik in alle agendamappen afgedrukt, zoals weergegeven in de onderstaande schermafbeelding.

Pak de verontrustende Outlook-corruptie aan

Als uw Outlook steeds op een ongepaste manier wordt afgesloten, kunt u later veel problemen tegenkomen. Onder hen is het beschadigd raken van het Outlook-bestand de ergste. Als u uw gegevens niet wilt verliezen, moet u een PST-fixtool gebruiken, zoals DataNumen Outlook Repair. Het is in staat om maximale gegevens terug te krijgen beschadigde Outlook bestand.

Auteur Introductie:

Shirley Zhang is een expert op het gebied van gegevensherstel in DataNumen, Inc., de wereldleider in technologieën voor gegevensherstel, waaronder sql-oplossing en Outlook-reparatiesoftwareproducten. Voor meer informatie bezoek www.datanumen.com