Comment imprimer la liste de tous les rendez-vous occupés dans une plage de dates spécifique via Outlook VBA

Cet article vous apprendra une méthode simple pour imprimer la liste de tous les rendez-vous qui sont affichés comme "occupés" et programmés dans une plage de dates spécifique.

Il est assez facile de parcourir tous les calendriers pour trouver tous les rendez-vous occupés dans une plage de dates spécifique. Il suffit de définir la portée de la recherche sur « Tous les éléments du calendrier ». Ensuite, recherchez les rendez-vous dont l'option « Afficher l'heure comme » est définie sur « Occupé » et qui se situent entre les dates de début et de fin spécifiées. Cependant, lorsque vous souhaitez imprimer les rendez-vous trouvés et que vous allez dans « Fichier » > « Imprimer », vous constaterez que seul le style « Mémo » est disponible. Cela signifie que vous ne pouvez pas imprimer les rendez-vous trouvés sous forme de liste. Si vous souhaitez imprimer la liste de ces rendez-vous, vous pouvez procéder comme suit.

Imprimer la liste de tous les rendez-vous occupés dans une plage de dates spécifique

1. Au tout début, lancez l'éditeur Outlook VBA via "Alt + F11".
2. Ensuite, dans la fenêtre contextuelle « Microsoft Visual Basic pour Applications », ajoutez la référence à « Bibliothèque d’objets MS Excel » conformément à « Comment ajouter une référence à une bibliothèque d'objets en VBA" .
3. Après cela, placez le code VBA suivant dans un module.

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. Plus tard, cliquez sur le premier sous-programme et appuyez sur la touche "F5".
5. Ensuite, vous devrez spécifier la plage de dates pour la recherche de rendez-vous.
6. Ensuite, cliquez sur "OK" pour continuer la macro.
7. Enfin, lorsque la macro se termine, la liste des rendez-vous occupés dans la plage de dates prédéfinie dans tous les dossiers du calendrier sera imprimée, comme indiqué dans la capture d'écran ci-dessous.

S'attaquer à la corruption inquiétante d'Outlook

Si votre Outlook est toujours fermé de manière inappropriée, vous risquez de rencontrer de nombreux problèmes plus tard. Parmi eux, le fichier Outlook corrompu est le pire. Si vous ne voulez pas perdre vos données, vous devez utiliser un outil de correction PST, comme DataNumen Outlook Repair. Il est capable de récupérer un maximum de données de Outlook endommagé fichier.

Introduction de l'auteur:

Shirley Zhang est une experte en récupération de données dans DataNumen, Inc., qui est le leader mondial des technologies de récupération de données, y compris correction sql et produits logiciels de réparation Outlook. Pour plus d'informations, visitez www.datanumen.com