Comment fusionner automatiquement tous les rendez-vous et réunions de tous les calendriers avec Outlook VBA

Si vous souhaitez toujours fusionner tous les rendez-vous et réunions de tous les calendriers dans un seul calendrier pour une vérification pratique, vous pouvez appliquer la méthode présentée dans cet article.

Peut-être avez-vous de nombreux comptes de messagerie configurés dans votre Outlook. Dans ce cas, vous devez avoir plusieurs calendriers dans votre Outlook. Par conséquent, chaque fois que vous souhaitez vérifier combien de rendez-vous il y a aujourd'hui, vous devez passer à tous les calendriers. Ce sera un peu gênant. Alors, pourquoi ne pas les fusionner en un seul calendrier ? Dans ce qui suit, nous allons exposer un morceau de code VBA, qui peut le réaliser facilement.

Fusion automatique de tous les rendez-vous et réunions de tous les calendriers

1. Au tout début, lancez votre application Outlook.
2. Après être entré dans la fenêtre principale d'Outlook, appuyez sur les touches "Alt + F11".
3. Ensuite, vous entrerez dans la fenêtre "Microsoft Visual Basic pour Applications".
4. Ensuite, vous devez rechercher et ouvrir le projet "ThisOutlookSession".
5. Ensuite, vous devez copier et coller les codes VBA suivants dans cette fenêtre de projet.

'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. Après cela, vous devez attribuer un certificat numérique à la macro actuelle.
7. Plus tard, allez dans "paramètres de macro" pour autoriser les macros signées numériquement.
8. Enfin, vous pouvez redémarrer votre programme Outlook pour activer la nouvelle macro.
9. À partir de maintenant, chaque fois qu'un nouveau rendez-vous ou une nouvelle réunion est ajouté dans les calendriers autres que ceux par défaut, il sera automatiquement copié dans le calendrier par défaut, comme dans la capture d'écran suivante :

Supprimer les éléments en retard du calendrier dans le temps

Comme nous le savons, Outlook est plus sujet à diverses erreurs lorsque la boîte aux lettres devient de plus en plus grande. Par conséquent, il est suggéré de supprimer à temps les éléments inutiles de la boîte aux lettres, tels que les rendez-vous et les réunions en retard. En attendant, il est préférable de garder à proximité un outil de réparation puissant, tel que DataNumen Outlook Repair. Il peut réparer Outlook problèmes sans transpirer.

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 récupération SQL et produits logiciels de réparation Outlook. Pour plus d'informations, visitez www.datanumen.com