Si të bashkoni automatikisht të gjitha takimet dhe takimet nga të gjithë kalendarët me Outlook VBA

Nëse dëshironi të bashkoni gjithmonë të gjitha takimet dhe takimet nga të gjithë kalendarët në një kalendar për kontroll të përshtatshëm, mund të aplikoni metodën e paraqitur në këtë artikull.

Ndoshta ju keni shumë llogari të postës elektronike të konfiguruara në Outlook tuaj. Në këtë rast, duhet të keni shumë kalendarë në Outlook tuaj. Prandaj, sa herë që dëshironi të kontrolloni se sa takime ka sot, duhet të kaloni në të gjithë kalendarët. Do të jetë pak e mundimshme. Pra, pse nuk i bashkoni ato në një kalendar? Në vijim do të ekspozojmë një pjesë të kodit VBA, i cili mund ta realizojë me lehtësi.

Bashkoni automatikisht të gjitha takimet dhe takimet nga të gjithë kalendarët

1. Që në fillim, hapni aplikacionin tuaj Outlook.
2. Pasi të keni hyrë në dritaren kryesore të Outlook, shtypni butonat "Alt + F11".
3. Pastaj do të futeni në dritaren "Microsoft Visual Basic për aplikacione".
4. Më pas ju duhet të gjeni dhe hapni projektin "ThisOutlookSession".
5. Më pas, ju duhet të kopjoni dhe ngjisni kodet e mëposhtme VBA në këtë dritare të projektit.

'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. Pas kësaj, ju duhet të caktoni një certifikatë dixhitale në makro aktuale.
7. Më vonë shkoni te "cilësimet makro" për të lejuar makrot e nënshkruara dixhitale.
8. Përfundimisht, ju mund të restart'i programit tuaj Outlook për të aktivizuar makro të re.
9. Që tani e tutje, sa herë që shtohet ndonjë takim ose takim i ri në kalendarët jo të parazgjedhur, ai do të kopjohet automatikisht në kalendarin e paracaktuar, si pamja e mëposhtme e ekranit:

Hiq artikujt e vonuar nga Kalendari në kohë

Siç e dimë, Outlook është më i prirur ndaj gabimeve të ndryshme kur kutia postare bëhet gjithnjë e më e madhe. Prandaj, sugjerohet të hiqni me kohë artikujt e padobishëm nga kutia postare, siç janë takimet dhe takimet e vonuara. Ndërkohë, është më mirë nëse mbani afër një mjet të fuqishëm riparimi, si p.sh DataNumen Outlook Repair. Mundet riparimi i Outlook probleme pa u djersitur.

Hyrje e autorit:

Shirley Zhang është një eksperte për rikuperimin e të dhënave DataNumen, Inc., e cila është lider botëror në teknologjitë e rikuperimit të të dhënave, duke përfshirë shërim sql dhe produkte softuerike të riparimit të pamjes. Për më shumë informacion vizitoni www.datanumen.com