Kako natisniti seznam vseh zasedenih sestankov v določenem časovnem obdobju prek Outlook VBA

Ta članek vas bo naučil enostavne metode za tiskanje seznama vseh sestankov, ki so prikazani kot »Zasedeno« in razporejeni v določenem časovnem obdobju.

Precej enostavno je prebrskati vse koledarje in najti vse zasedene sestanke v določenem datumskem obdobju. Preprosto lahko nastavite obseg iskanja na »Vsi elementi koledarja«. Nato poiščite sestanke, pri katerih je »Prikaži čas kot« enak »Zaseden« in so znotraj določenega začetnega in končnega datuma. Ko pa želite natisniti najdene sestanke in odprete »Datoteka« > »Natisni«, boste videli, da je na voljo samo »Slog beležke«. To pomeni, da najdenih sestankov ne morete natisniti na seznamu. Če torej želite natisniti seznam takšnih sestankov, lahko uporabite naslednji način.

Natisnite seznam vseh zasedenih sestankov v določenem časovnem obdobju

1. Na začetku zaženite urejevalnik Outlook VBA prek »Alt + F11«.
2. Nato v pojavnem oknu »Microsoft Visual Basic for Applications« dodajte sklic na »Knjižnica objektov MS Excel« v skladu z »Kako dodati referenco knjižnice objektov v VBA".
3. Po tem v modul vstavite naslednjo kodo VBA.

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. Pozneje kliknite prvo podprogram in pritisnite tipko “F5”.
5. Nato boste morali določiti časovno obdobje za iskanje sestankov.
6. Nato kliknite »V redu« za nadaljevanje makra.
7. Ko se makro konča, se natisne seznam zasedenih sestankov v vnaprej določenem časovnem obdobju v vseh mapah koledarja, kot je prikazano na spodnjem posnetku zaslona.

Odpravljanje moteče Outlook korupcije

Če je vaš Outlook vedno neprimerno zaprt, boste pozneje morda naleteli na veliko težav. Med njimi je najhujša datoteka Outlook, ki je poškodovana. Če ne želite izgubiti podatkov, morate uporabiti orodje za popravljanje PST, na primer DataNumen Outlook Repair. Lahko vrne največ podatkov iz poškodovan Outlook Datoteka.

Uvod avtorja:

Shirley Zhang je strokovnjakinja za obnovitev podatkov v DataNumen, Inc., ki je vodilna na svetu na področju tehnologij za obnovitev podatkov, vključno z sql popravek in obeti za popravilo programskih izdelkov. Za več informacij obiščite www.datanumen.com