Cómo imprimir la lista de todas las citas ocupadas en un rango de fechas específico a través de Outlook VBA

Comparte ahora:

Este artículo le enseñará un método sencillo para imprimir la lista de todas las citas que se muestran como "Ocupadas" y programadas en un rango de fechas específico.

Es bastante fácil recorrer todos los calendarios para encontrar todas las citas ocupadas en un rango de fechas específico. Simplemente puede establecer el alcance de la búsqueda en "Todos los elementos del calendario". Luego, busque citas con "Mostrar hora como" igual a "Ocupado" y dentro de la fecha de inicio y fecha de finalización específicas. Pero, de esta manera, cuando intente imprimir las citas encontradas y vaya a "Archivo" > "Imprimir", puede ver que solo está disponible el "Estilo de nota". Esto significa que no puede imprimir las citas encontradas en una lista. Entonces, si desea imprimir la lista de dichas citas, puede usar la siguiente manera.

Solo estilo de nota disponible para citas encontradas

Imprima la lista de todas las citas ocupadas en un rango de fechas específico

  1. Desde el principio, inicie el editor de Outlook VBA a través de “Alt + F11”.
  2. Luego, en la ventana emergente “Microsoft Visual Basic para Aplicaciones”, agregue la referencia a “Biblioteca de objetos de MS Excel” de acuerdo con “Cómo agregar una referencia a una biblioteca de objetos en VBA".
  3. Después de eso, coloque el siguiente código VBA en un 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

Código VBA: imprima la lista de todas las citas ocupadas en un rango de fechas específico

  1. Luego, haga clic en la primera subrutina y presione el botón de la tecla "F5".
  2. A continuación, se le pedirá que especifique el rango de fechas para buscar citas.Especificar rango de fechas
  3. Posteriormente, haga clic en "Aceptar" para continuar con la macro.
  4. Finalmente, cuando finalice la macro, se imprimirá la lista de citas ocupadas en el rango de fechas predefinido en todas las carpetas del calendario, como se muestra en la captura de pantalla a continuación.Lista impresa de todas las citas ocupadas en un rango de fechas específico

Abordar la inquietante corrupción de perspectivas

Si su Outlook siempre se cierra de manera incorrecta, es posible que encuentre muchos problemas más adelante. Entre ellos, el archivo de Outlook dañado es el peor. Si no desea perder sus datos, debe utilizar una herramienta de reparación de PST, como DataNumen Outlook Repair. Es capaz de recuperar el máximo de datos de Outlook dañado .

Introducción del autor:

Shirley Zhang es experta en recuperación de datos en DataNumen, Inc., que es el líder mundial en tecnologías de recuperación de datos, incluyendo corrección de sql y productos de software de reparación de Outlook. Para más información visite www.datanumen.com

Comparte ahora:

Los comentarios están cerrados.