Como imprimir a lista de todos os compromissos ocupados em um intervalo de datas específico via Outlook VBA

Este artigo ensinará a você um método fácil de imprimir a lista de todos os compromissos exibidos como “Ocupados” e agendados em um intervalo de datas específico.

É bastante fácil percorrer todos os calendários para encontrar todos os compromissos ocupados em um intervalo de datas específico. Basta definir o escopo da pesquisa para "Todos os itens do calendário". Em seguida, pesquise os compromissos com "Exibir horário como" igual a "Ocupado" e dentro da data de início e término especificadas. No entanto, dessa forma, ao tentar imprimir os compromissos encontrados e acessar "Arquivo" > "Imprimir", você verá que apenas o "Estilo de memorando" está disponível. Isso significa que você não pode imprimir os compromissos encontrados em formato de lista. Portanto, se você quiser imprimir a lista desses compromissos, pode usar o seguinte método.

Imprima a lista de todos os compromissos ocupados em um intervalo de datas específico

1. No início, inicie o editor VBA do Outlook via “Alt + F11”.
2. Em seguida, na janela pop-up “Microsoft Visual Basic for Applications”, adicione a referência à “Biblioteca de Objetos do MS Excel” de acordo com “Como adicionar uma referência à biblioteca de objetos em VBA".
3. Depois disso, coloque o seguinte código VBA em um módulo.

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. Posteriormente, clique na primeira sub-rotina e pressione a tecla “F5”.
5. Em seguida, você deve especificar o intervalo de datas para procurar compromissos.
6. Posteriormente, clique em “OK” para continuar a macro.
7. Por fim, quando a macro terminar, a lista de compromissos ocupados no intervalo de datas predefinido em todas as pastas do calendário será impressa, conforme mostrado na captura de tela abaixo.

Enfrente a perturbadora corrupção do Outlook

Se o Outlook estiver sempre fechado de maneira inadequada, você poderá encontrar muitos problemas posteriormente. Entre eles, o arquivo do Outlook corrompido é o pior. Se você não quer perder seus dados, você precisa usar uma ferramenta de correção de PST, como DataNumen Outlook Repair. É capaz de recuperar dados máximos de Outlook danificado arquivo.

Introdução do autor:

Shirley Zhang é especialista em recuperação de dados em DataNumen, Inc., líder mundial em tecnologias de recuperação de dados, incluindo correção de sql e produtos de software de reparo do Outlook. Para mais informações visite www.datanumen.com