Outlook VBA ile Tüm Takvimlerdeki Tüm Randevuları ve Toplantıları Otomatik Olarak Birleştirme

Tüm takvimlerdeki tüm randevuları ve toplantıları uygun kontrol için her zaman tek bir takvimde birleştirmek istiyorsanız, bu makalede açıklanan yöntemi uygulayabilirsiniz.

Belki de Outlook'unuzda yapılandırılmış birçok e-posta hesabınız vardır. Bu durumda, Outlook'unuzda birçok takviminiz olmalıdır. Bu nedenle, bugün kaç randevu olduğunu kontrol etmek istediğinizde, tüm takvimlere geçmeniz gerekir. Biraz sıkıntılı olacak. Öyleyse neden onları tek bir takvimde birleştirmiyorsun? Aşağıda, onu kolaylıkla gerçekleştirebilecek bir VBA kodu parçası göstereceğiz.

Tüm Randevuları ve Toplantıları Tüm Takvimlerden Otomatik Olarak Birleştir

1. En başta, Outlook uygulamanızı başlatın.
2. Ana Outlook penceresine girdikten sonra “Alt + F11” tuşlarına basın.
3. Ardından “Uygulamalar için Microsoft Visual Basic” penceresine gireceksiniz.
4. Daha sonra “ThisOutlookSession” projesini bulup açmanız gerekiyor.
5. Daha sonra aşağıdaki VBA kodlarını kopyalayıp bu proje penceresine yapıştırmanız gerekmektedir.

'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. Bundan sonra, geçerli makroya bir dijital sertifika atamanız gerekir.
7. Daha sonra dijital olarak imzalanmış makrolara izin vermek için “makro ayarlarına” gidin.
8. Sonunda, çözebilirsintar• Yeni makroyu etkinleştirmek için Outlook programınız.
9. Bundan sonra, varsayılan olmayan takvimlere her yeni randevu veya toplantı eklendiğinde, aşağıdaki ekran görüntüsü gibi otomatik olarak varsayılan takvime kopyalanacak:

Vadesi Geçmiş Öğeleri Takvimden Zamanında Kaldırın

Bildiğimiz gibi, posta kutusu büyüdükçe Outlook çeşitli hatalara daha yatkındır. Bu nedenle geciken randevular ve toplantılar gibi işe yaramaz öğelerin posta kutusundan zamanında çıkarılması önerilir. Bu arada, yakınınızda güçlü bir tamir aleti bulundurmanız daha iyi olur. DataNumen Outlook Repair. Bu olabilir Outlook'u onar ter dökmeden sorunlar.

Yazar Tanıtımı:

Shirley Zhang, bir veri kurtarma uzmanıdır. DataNumendahil olmak üzere veri kurtarma teknolojilerinde dünya lideri olan , Inc. sql kurtarma ve görünüm onarım yazılım ürünleri. Daha fazla bilgi için ziyaret edin www.datanumen.com