Cum să imprimați lista tuturor programărilor ocupate într-un interval de date specific prin Outlook VBA

Acest articol vă va învăța o metodă ușoară de a tipări lista tuturor întâlnirilor care sunt afișate ca „Ocupat” și programate într-un interval de date specific.

Este destul de ușor să parcurgi toate calendarele pentru a găsi toate programările ocupate într-un anumit interval de date. Poți seta domeniul de căutare la „Toate elementele din calendar”. Apoi, caută programări cu „Afișează ora ca” egal cu „Ocupat” și în limitele datei de început și de sfârșit specificate. Dar, în acest fel, atunci când intenționezi să imprimi programările găsite și accesezi „Fișier” > „Imprimare”, poți vedea că este disponibil doar „Stil memo”. Aceasta înseamnă că nu poți imprima programările găsite în listă. Așadar, dacă dorești să imprimi lista acestor programări, poți utiliza următoarea metodă.

Tipăriți lista tuturor întâlnirilor ocupate într-un interval de date specific

1. De la bun început, lansați editorul Outlook VBA prin „Alt + F11”.
2. Apoi, în fereastra pop-up „Microsoft Visual Basic for Applications”, adăugați referința la „MS Excel Object Library” în conformitate cu „Cum se adaugă o referință la o bibliotecă de obiecte în VBA".
3. După aceea, puneți următorul cod VBA într-un 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. Mai târziu, faceți clic pe prima subrutină și apăsați butonul „F5”.
5. În continuare, vi se va cere să specificați intervalul de date pentru căutarea întâlnirilor.
6. Ulterior, faceți clic pe „OK” pentru a continua macrocomanda.
7. În cele din urmă, când macro-ul se termină, va fi tipărită lista de întâlniri ocupate din intervalul de date predefinit din toate folderele calendarului, așa cum se arată în captura de ecran de mai jos.

Abordați corupția perturbatoare din Outlook

Dacă Outlook este întotdeauna închis într-un mod necorespunzător, este posibil să întâmpinați o mulțime de probleme mai târziu. Printre acestea, fișierul Outlook corupt este cel mai rău. Dacă nu doriți să vă pierdeți datele, trebuie să utilizați un instrument de remediere PST, cum ar fi DataNumen Outlook Repair. Este capabil să recupereze date maxime de la Outlook deteriorat fișier.

Introducerea autorului:

Shirley Zhang este expertă în recuperarea datelor DataNumen, Inc., care este lider mondial în tehnologiile de recuperare a datelor, inclusiv remediere sql și produse software de reparații Outlook. Pentru mai multe informații vizitați www.datanumen.com