Πώς να εκτυπώσετε τη λίστα όλων των απασχολημένων συναντήσεων σε ένα συγκεκριμένο εύρος ημερομηνιών μέσω του Outlook VBA

Αυτό το άρθρο θα σας διδάξει μια εύκολη μέθοδο για να εκτυπώσετε τη λίστα με όλα τα ραντεβού που εμφανίζονται ως "Απασχολημένο" και έχουν προγραμματιστεί σε ένα συγκεκριμένο εύρος ημερομηνιών.

Είναι αρκετά εύκολο να κάνετε επανάληψη σε όλα τα ημερολόγια για να βρείτε όλα τα απασχολημένα ραντεβού σε ένα συγκεκριμένο εύρος ημερομηνιών. Μπορείτε απλώς να ορίσετε το εύρος αναζήτησης σε "Όλα τα στοιχεία ημερολογίου". Στη συνέχεια, η αναζήτηση ραντεβού με "Εμφάνιση ώρας ως" ισούται με "Απασχολημένος" και εντός της συγκεκριμένης ημερομηνίας έναρξης και λήξης. Αλλά, με αυτόν τον τρόπο, όταν σκοπεύετε να εκτυπώσετε τα ραντεβού που βρέθηκαν και μεταβείτε στο "Αρχείο" > "Εκτύπωση", μπορείτε να δείτε ότι υπάρχει διαθέσιμο μόνο το "Στυλ σημειώματος". Αυτό σημαίνει ότι δεν μπορείτε να εκτυπώσετε τα ραντεβού που βρέθηκαν στη λίστα. Επομένως, εάν θέλετε να εκτυπώσετε τη λίστα τέτοιων ραντεβού, μπορείτε να χρησιμοποιήσετε τον ακόλουθο τρόπο.

Εκτυπώστε τη λίστα όλων των απασχολημένων συναντήσεων σε ένα συγκεκριμένο εύρος ημερομηνιών

1. Στην αρχή, ξεκινήστε τον επεξεργαστή Outlook VBA μέσω του "Alt + F11".
2. Στη συνέχεια, στο αναδυόμενο παράθυρο "Microsoft Visual Basic for Applications", προσθέστε την αναφορά στο "MS Excel Object Library" σύμφωνα με το "Πώς να προσθέσετε μια αναφορά βιβλιοθήκης αντικειμένων σε VBA".
3. Μετά από αυτό, τοποθετήστε τον ακόλουθο κώδικα 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. Αργότερα, κάντε κλικ στην πρώτη υπορουτίνα και πατήστε το πλήκτρο "F5".
5. Στη συνέχεια, θα σας ζητηθεί να καθορίσετε το εύρος ημερομηνιών για την αναζήτηση συναντήσεων.
6. Στη συνέχεια, κάντε κλικ στο "OK" για να συνεχίσετε τη μακροεντολή.
7. Τέλος, όταν ολοκληρωθεί η μακροεντολή, θα εκτυπωθεί η λίστα των απασχολημένων συναντήσεων στο προκαθορισμένο εύρος ημερομηνιών σε όλους τους φακέλους ημερολογίου, όπως φαίνεται στο παρακάτω στιγμιότυπο οθόνης.

Αντιμετωπίστε την ενοχλητική διαφθορά του Outlook

Εάν το Outlook σας είναι πάντα κλειστό με ακατάλληλο τρόπο, ενδέχεται να αντιμετωπίσετε πολλά ζητήματα αργότερα. Μεταξύ αυτών, το κατεστραμμένο αρχείο του Outlook είναι το χειρότερο. Εάν δεν θέλετε να χάσετε τα δεδομένα σας, πρέπει να χρησιμοποιήσετε ένα εργαλείο επιδιόρθωσης PST, όπως π.χ DataNumen Outlook Repair. Είναι σε θέση να ανακτήσει τα μέγιστα δεδομένα από κατεστραμμένο Outlook αρχείο.

Εισαγωγή συγγραφέα:

Η Shirley Zhang είναι ειδικός ανάκτησης δεδομένων στο DataNumen, Inc., η οποία είναι ο παγκόσμιος ηγέτης στις τεχνολογίες ανάκτησης δεδομένων, συμπεριλαμβανομένων επιδιόρθωση sql και προϊόντα λογισμικού επισκευής προοπτικών. Για περισσότερες πληροφορίες επισκεφθείτε www.datanumen.com