Sådan flettes alle aftaler og møder automatisk fra alle kalendere med Outlook VBA

Hvis du altid vil flette alle aftaler og møder fra alle kalendere til en kalender for nem kontrol, kan du anvende metoden introduceret i denne artikel.

Måske har du konfigureret mange e-mail-konti i din Outlook. I dette tilfælde skal du have mange kalendere i din Outlook. Derfor skal du skifte til alle kalendere, hver gang du vil kontrollere, hvor mange aftaler der er i dag. Det bliver lidt besværligt. Så hvorfor fletter du dem ikke sammen i en kalender? I det følgende vil vi udsætte et stykke VBA-kode, som let kan realisere det.

Flet automatisk alle aftaler og møder fra alle kalendere

1. Start din Outlook-applikation lige fra starten.
2. Når du har åbnet Outlook-hovedvinduet, skal du trykke på “Alt + F11” -tasten.
3. Derefter kommer du ind i "Microsoft Visual Basic for Applications" -vinduet.
4. Dernæst skal du finde og åbne projektet “ThisOutlookSession”.
5. Derefter skal du kopiere og indsætte følgende VBA-koder i dette projektvindue.

'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. Derefter skal du tildele et digitalt certifikat til den aktuelle makro.
7. Gå senere til “makroindstillinger” for at tillade digitalt signerede makroer.
8. Til sidst kan du restart dit Outlook-program for at aktivere den nye makro.
9. Fra nu af, hver gang der tilføjes en ny aftale eller et møde i de ikke-standardkalendere, kopieres den automatisk til standardkalenderen, som f.eks. Følgende skærmbillede:

Fjern forsinkede emner fra kalenderen i tiden

Som vi ved, er Outlook mere tilbøjelig til forskellige fejl, når postkassen bliver større og større. Derfor foreslås det at fjerne ubrugelige genstande fra postkassen i tide, f.eks. Forsinkede aftaler og møder. I mellemtiden er det bedre, hvis du opbevarer et kraftigt reparationsværktøj i nærheden, f.eks DataNumen Outlook Repair. Det kan reparere Outlook problemer uden at svede.

Forfatter Introduktion:

Shirley Zhang er ekspert i datagendannelse i DataNumen, Inc., som er verdens førende inden for datagendannelsesteknologier, herunder sql opsving og Outlook-reparationssoftwareprodukter. For mere information besøg www.datanumen.com