Slik slår du automatisk sammen alle avtaler og møter fra alle kalendere med Outlook VBA

Hvis du alltid vil slå sammen alle avtaler og møter fra alle kalendere til én kalender for praktisk sjekk, kan du bruke metoden introdusert i denne artikkelen.

Kanskje du har mange e-postkontoer konfigurert i Outlook. I dette tilfellet må du ha mange kalendere i Outlook. Derfor, hver gang du vil sjekke hvor mange avtaler det er i dag, må du bytte til alle kalenderne. Det blir litt plagsomt. Så hvorfor slår du dem sammen til én kalender? I det følgende vil vi avsløre et stykke VBA-kode, som enkelt kan realisere det.

Slå automatisk sammen alle avtaler og møter fra alle kalendere

1. Start Outlook-applikasjonen helt i begynnelsen.
2. Etter at du har åpnet hovedvinduet i Outlook, trykker du på "Alt + F11"-tastene.
3. Deretter kommer du inn i "Microsoft Visual Basic for Applications"-vinduet.
4. Deretter må du finne og åpne "ThisOutlookSession" -prosjektet.
5. Deretter bør du kopiere og lime inn følgende VBA-koder i dette prosjektvinduet.

'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. Etter det må du tilordne et digitalt sertifikat til gjeldende makro.
7. Gå senere til "makroinnstillinger" for å tillate de digitalt signerte makroene.
8. Etter hvert kan du restart Outlook-programmet for å aktivere den nye makroen.
9. Fra nå av, hver gang en ny avtale eller et møte legges til i ikke-standardkalendere, vil det automatisk kopieres til standardkalenderen, som følgende skjermbilde:

Fjern forfalte elementer fra kalenderen i tide

Outlook er som kjent mer utsatt for ulike feil når postkassen blir større og større. Derfor foreslås det å fjerne ubrukelige gjenstander fra postkassen i tide, for eksempel forfalte avtaler og møter. I mellomtiden er det bedre om du har et potent reparasjonsverktøy i nærheten, som f.eks DataNumen Outlook Repair. Det kan reparere Outlook problemer uten å svette.

Forfatterintroduksjon:

Shirley Zhang er en datagjenopprettingsekspert innen DataNumen, Inc., som er verdensledende innen datagjenopprettingsteknologier, inkludert sql utvinning og Outlook-reparasjonsprodukter. For mer informasjon besøk www.datanumen. Med