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

Εάν θέλετε να συγχωνεύετε πάντα όλες τις συναντήσεις και τις συναντήσεις από όλα τα ημερολόγια σε ένα ημερολόγιο για εύκολο έλεγχο, μπορείτε να εφαρμόσετε τη μέθοδο που παρουσιάζεται σε αυτό το άρθρο.

Ίσως έχετε πολλούς λογαριασμούς email διαμορφωμένους στο Outlook σας. Σε αυτήν την περίπτωση, πρέπει να έχετε πολλά ημερολόγια στο Outlook. Επομένως, κάθε φορά που θέλετε να ελέγξετε πόσα ραντεβού υπάρχουν σήμερα, πρέπει να μεταβείτε σε όλα τα ημερολόγια. Θα είναι λίγο ενοχλητικό. Λοιπόν, γιατί δεν τα συγχωνεύετε σε ένα ημερολόγιο; Στη συνέχεια, θα εκθέσουμε ένα κομμάτι κώδικα VBA, το οποίο μπορεί να το πραγματοποιήσει με ευκολία.

Αυτόματη συγχώνευση όλων των ραντεβού και των συναντήσεων από όλα τα ημερολόγια

1. Στην αρχή, ξεκινήστε την εφαρμογή Outlook.
2. Αφού εισέλθετε στο κύριο παράθυρο του Outlook, πατήστε τα πλήκτρα "Alt + F11".
3. Στη συνέχεια, θα μεταβείτε στο παράθυρο "Microsoft Visual Basic για Εφαρμογές".
4. Στη συνέχεια, πρέπει να βρείτε και να ανοίξετε το έργο "ThisOutlookSession".
5. Στη συνέχεια, θα πρέπει να αντιγράψετε και να επικολλήσετε τους ακόλουθους κωδικούς VBA σε αυτό το παράθυρο του έργου.

'Here we take two calendars as an example - "Calendar A" & "Calendar B"
'You can add more as per your needs
Dim WithEvents objACalendarItems As Outlook.Items
Dim WithEvents objBCalendarItems As Outlook.Items
Dim objDefaultCalendar As Outlook.Folder
 
Private Sub Application_Startup()
    Set objACalendarItems = Application.Session.folders("File A").folders("Calendar").Items
    Set objBCalendarItems = Application.Session.folders("File B").folders("Calendar").Items

    'Here we merge into the default calendar
    Set objDefaultCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)
End Sub
 
Private Sub objACalendarItems_ItemAdd(ByVal Item As Object)
    Call CopyToDefaultCalendar(Item)
End Sub

Private Sub objBCalendarItems_ItemAdd(ByVal Item As Object)
    Call CopyToDefaultCalendar(Item)
End Sub

Private Sub CopyToDefaultCalendar(ByVal objItem As Object)
    Dim objCopiedAppointment As Outlook.AppointmentItem
    Dim objMoviedAppointment As Outlook.AppointmentItem
    Dim strPSTFileName As String
 
    Set objCopiedAppointment = objItem.Copy
    Set objMoviedAppointment = objCopiedAppointment.Move(objDefaultCalendar)
 
    strPSTFileName = objItem.parent.parent.Name
 
    'Tag the source of the copied appointments
    objMoviedAppointment.Categories = "From " & strPSTFileName
    objMoviedAppointment.Save
    'If want to delete it from the original calendar, add the following line:
    'objItem.Delete
End Sub

6. Μετά από αυτό, πρέπει να αντιστοιχίσετε ένα ψηφιακό πιστοποιητικό στην τρέχουσα μακροεντολή.
7. Αργότερα μεταβείτε στις "ρυθμίσεις μακροεντολών" για να επιτρέψετε τις ψηφιακά υπογεγραμμένες μακροεντολές.
8. Τελικά, μπορείτε να κάνετε restart το πρόγραμμα Outlook για να ενεργοποιήσετε τη νέα μακροεντολή.
9. Από εδώ και στο εξής, κάθε φορά που προστίθεται νέα συνάντηση ή συνάντηση στα μη προεπιλεγμένα ημερολόγια, θα αντιγράφεται αυτόματα στο προεπιλεγμένο ημερολόγιο, όπως το ακόλουθο στιγμιότυπο οθόνης:

Καταργήστε τα ληξιπρόθεσμα στοιχεία από το Ημερολόγιο εγκαίρως

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

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

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