Cara Otomatis Menggabungkan Semua Janji & Rapat dari Semua Kalender dengan Outlook VBA

Jika Anda ingin selalu menggabungkan semua janji dan rapat dari semua kalender menjadi satu kalender untuk memudahkan pemeriksaan, Anda dapat menerapkan metode yang diperkenalkan di artikel ini.

Mungkin Anda memiliki banyak akun email yang dikonfigurasi di Outlook Anda. Dalam kasus ini, Anda harus memiliki banyak kalender di Outlook Anda. Oleh karena itu, setiap kali Anda ingin memeriksa berapa banyak janji temu hari ini, Anda harus beralih ke semua kalender. Ini akan sedikit merepotkan. Jadi, mengapa Anda tidak menggabungkannya menjadi satu kalender? Berikut ini, kami akan memaparkan sepotong kode VBA, yang dapat merealisasikannya dengan mudah.

Otomatis Gabungkan Semua Janji & Rapat dari Semua Kalender

1. Pertama-tama, luncurkan aplikasi Outlook Anda.
2. Setelah Anda masuk ke jendela Outlook utama, tekan tombol "Alt + F11".
3. Kemudian Anda akan masuk ke jendela "Microsoft Visual Basic for Applications".
4. Selanjutnya Anda perlu mencari dan membuka proyek "ThisOutlookSession".
5. Selanjutnya, Anda harus menyalin dan menempelkan kode VBA berikut ke dalam jendela proyek ini.

'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. Setelah itu, Anda perlu menetapkan sertifikat digital ke makro saat ini.
7. Nanti pergi ke "pengaturan makro" untuk mengizinkan makro yang ditandatangani secara digital.
8. Akhirnya, Anda bisa restart program Outlook Anda untuk mengaktifkan makro baru.
9. Mulai sekarang, setiap kali ada janji atau pertemuan baru ditambahkan di kalender non-default, itu akan otomatis disalin ke kalender default, seperti gambar berikut:

Hapus Item yang Terlambat dari Kalender dalam Waktu

Seperti yang kita ketahui, Outlook lebih rentan terhadap berbagai kesalahan saat kotak surat menjadi semakin besar. Oleh karena itu, disarankan untuk menghapus item yang tidak berguna dari kotak surat tepat waktu, seperti janji temu dan rapat yang lewat waktu. Sementara itu, akan lebih baik jika Anda menyimpan alat perbaikan yang kuat di dekat Anda, seperti DataNumen Outlook Repair. Hal ini dapat perbaiki Outlook masalah tanpa berkeringat.

Pengantar Penulis:

Shirley Zhang adalah pakar pemulihan data di DataNumen, Inc., yang merupakan pemimpin dunia dalam teknologi pemulihan data, termasuk pemulihan sql dan produk perangkat lunak perbaikan pandangan. Untuk informasi lebih lanjut kunjungi www.datanumen.com