Sådan udskrives listen over alle travle aftaler i et bestemt datointerval via Outlook VBA

Denne artikel vil lære dig en nem metode til at udskrive listen over alle de aftaler, der er vist som "Optaget" og planlagt i et bestemt datointerval.

Det er ret nemt at gennemgå alle kalendere for at finde alle travle aftaler i et bestemt datointerval. Du kan blot indstille søgeområdet til "Alle kalenderelementer". Søg derefter efter aftaler, hvor "Vis tidspunkt som" er lig med "Optaget" og inden for den specifikke startdato og slutdato. Men på denne måde, når du har til hensigt at udskrive de fundne aftaler og går til "Fil" > "Udskriv", kan du se, at der kun er "Memo-stil" tilgængelig. Det betyder, at du ikke kan udskrive de fundne aftaler på listen. Så hvis du vil udskrive listen over sådanne aftaler, kan du bruge følgende metode.

Udskriv listen over alle travle aftaler i et bestemt datointerval

1. I starten startes Outlook VBA-editor via “Alt + F11”.
2. Tilføj derefter referencen til "MS Excel Object Library" i pop op-vinduet "Microsoft Visual Basic for Applications" i overensstemmelse med "Sådan tilføjer du en objektbiblioteksreference i VBA".
3. Derefter skal du sætte følgende VBA-kode i et modul.

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 senere på den første underrutine og tryk på "F5"-tasten.
5. Derefter skal du angive datointervallet for søgning efter aftaler.
6. Klik derefter på "OK" for at fortsætte makroen.
7. Til sidst, når makroen er færdig, vil listen over travle aftaler i det foruddefinerede datointerval i alle kalendermapper blive udskrevet, som vist på skærmbilledet nedenfor.

Bekæmp forstyrrende Outlook-korruption

Hvis din Outlook altid er lukket på en forkert måde, kan du støde på en masse problemer senere. Blandt dem er Outlook-fil, der er beskadiget, den værste. Hvis du ikke vil miste dine data, skal du bruge et PST-fixværktøj, som f.eks DataNumen Outlook Repair. Det er i stand til at få maksimal data tilbage fra beskadiget Outlook fil.

Forfatter Introduktion:

Shirley Zhang er ekspert i datagendannelse i DataNumen, Inc., som er verdens førende inden for datagendannelsesteknologier, herunder sql rettelse og Outlook-reparationssoftwareprodukter. For mere information besøg www.datanumen.com