Az összes találkozó és értekezlet automatikus egyesítése az összes naptárból az Outlook VBA segítségével

Ha az összes találkozót és értekezletet az összes naptárból egy naptárba szeretné egyesíteni a kényelmes ellenőrzés érdekében, alkalmazza az ebben a cikkben bemutatott módszert.

Lehet, hogy sok e-mail fiókja van beállítva az Outlookban. Ebben az esetben sok naptárnak kell lennie az Outlookban. Ezért minden alkalommal, amikor ellenőrizni szeretné, hány találkozó van ma, át kell váltania az összes naptárra. Ez egy kicsit zavaró lesz. Szóval, miért nem egyesíti őket egy naptárba? A következőkben bemutatunk egy VBA-kódot, amely könnyedén megvalósítható.

Az összes találkozó és találkozó automatikus egyesítése az összes naptárból

1. A legelején indítsa el az Outlook alkalmazást.
2. Miután belépett az Outlook főablakába, nyomja meg az „Alt + F11” billentyűket.
3. Ezután megjelenik a „Microsoft Visual Basic for Applications” ablak.
4. Ezután meg kell találnia és meg kell nyitnia a „ThisOutlookSession” projektet.
5. Ezt követően másolja és illessze be a következő VBA-kódokat ebbe a projektablakba.

'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. Ezt követően hozzá kell rendelnie egy digitális tanúsítványt az aktuális makróhoz.
7. Később lépjen a „makróbeállításokhoz” a digitálisan aláírt makrók engedélyezéséhez.
8. Végül restart az Outlook programban az új makró aktiválásához.
9. Mostantól minden alkalommal, amikor új találkozót vagy értekezletet adnak a nem alapértelmezett naptárakba, a rendszer automatikusan átmásolja az alapértelmezett naptárba, például a következő képernyőképen:

Időben távolítsa el a lejárt tételeket a naptárból

Mint tudjuk, az Outlook hajlamosabb a különféle hibákra, amikor a postafiók egyre nagyobb lesz. Ezért azt javasoljuk, hogy időben távolítsák el a postaládából a haszontalan küldeményeket, például a lejárt időpontokat, megbeszéléseket. Addig is jobb, ha a közelben tart egy erős javítószerszámot, mint pl DataNumen Outlook Repair. Az tud javítás Outlook problémákat anélkül, hogy izzadna.

Szerző Bevezetés:

Shirley Zhang adat-helyreállítási szakértő DataNumen, Inc., amely világelső az adat-helyreállítási technológiák területén, beleértve sql helyreállítás és outlook javítószoftver termékek. További információért látogasson el www.datanumen.com