Kako odštampati listu svih zauzetih sastanaka u određenom rasponu datuma putem Outlook VBA

Ovaj članak će vas naučiti jednostavnom načinu da odštampate listu svih sastanaka koji su prikazani kao „Zauzeti“ i zakazani u određenom periodu.

Prilično je jednostavno pregledati sve kalendare kako biste pronašli sve zauzete sastanke u određenom rasponu datuma. Možete jednostavno postaviti opseg pretrage na "Sve stavke kalendara". Zatim pretražite sastanke kod kojih je "Prikaži vrijeme kao" jednako "Zauzeto" i unutar određenog datuma početka i datuma završetka. Međutim, na ovaj način, kada namjeravate ispisati pronađene sastanke i odete na "Datoteka" > "Ispis", možete vidjeti da je dostupan samo "Stil bilješke". To znači da ne možete ispisati pronađene sastanke s popisa. Dakle, ako želite ispisati popis takvih sastanaka, možete koristiti sljedeći način.

Odštampajte listu svih zauzetih sastanaka u određenom rasponu datuma

1. Na samom početku pokrenite Outlook VBA editor preko “Alt + F11”.
2. Zatim, u iskačućem prozoru „Microsoft Visual Basic for Applications“ dodajte referencu na „MS Excel Object Library“ u skladu sa „Kako dodati referencu biblioteke objekata u VBA".
3. Nakon toga, stavite sljedeći VBA kod u 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. Kasnije kliknite na prvu potprogram i pritisnite tipku “F5”.
5. Zatim, od vas će se tražiti da navedete raspon datuma za traženje obaveza.
6. Zatim kliknite na “OK” da nastavite makro.
7. Konačno, kada se makro završi, lista zauzetih obaveza u unapred definisanom rasponu datuma u svim fasciklama kalendara biće odštampana, kao što je prikazano na slici ispod.

Pozabavite se uznemirujućom korupcijom Outlooka

Ako je vaš Outlook uvijek zatvoren na neodgovarajući način, kasnije možete naići na mnogo problema. Među njima, Outlook datoteka koja je oštećena je najgora. Ako ne želite da izgubite svoje podatke, trebate koristiti PST alat za popravku, npr DataNumen Outlook Repair. Može povratiti maksimalan broj podataka oštećen Outlook fajl.

Uvod za autora:

Shirley Zhang je stručnjak za oporavak podataka DataNumen, Inc., koji je svjetski lider u tehnologijama za oporavak podataka, uključujući sql fix i Outlook softverski proizvodi za popravku. Za više informacija posjetite www.datanumen.com