Cara Mencetak Daftar Semua Janji yang Sibuk dalam Rentang Tanggal Tertentu melalui Outlook VBA

Artikel ini akan mengajarkan Anda metode mudah untuk mencetak daftar semua janji temu yang ditampilkan sebagai "Sibuk" dan dijadwalkan dalam rentang tanggal tertentu.

Cukup mudah untuk menelusuri semua kalender untuk menemukan semua janji temu yang sibuk dalam rentang tanggal tertentu. Anda cukup mengatur cakupan pencarian ke "Semua Item Kalender". Kemudian, cari janji temu dengan "Tampilkan Waktu Sebagai" sama dengan "Sibuk" dan dalam rentang tanggal mulai dan tanggal akhir tertentu. Namun, dengan cara ini, ketika bermaksud mencetak janji temu yang ditemukan dan pergi ke "File" > "Cetak", Anda dapat melihat bahwa hanya "Gaya Memo" yang tersedia. Artinya, Anda tidak dapat mencetak janji temu yang ditemukan dalam bentuk daftar. Jadi, jika Anda ingin mencetak daftar janji temu tersebut, Anda dapat menggunakan cara berikut.

Cetak Daftar Semua Janji yang Sibuk dalam Rentang Tanggal Tertentu

1. Pertama-tama, luncurkan editor Outlook VBA melalui "Alt + F11".
2. Kemudian, di jendela pop-up “Microsoft Visual Basic for Applications”, tambahkan referensi ke “MS Excel Object Library” sesuai dengan “Cara Menambahkan Referensi Pustaka Objek di VBA".
3. Setelah itu, masukkan kode VBA berikut ke dalam modul.

Dim dStart, dEnd As Date
Dim objExcelApp As Excel.Application
Dim objExcelWorkbook As Excel.Workbook
Dim objExcelWorksheet As Excel.Worksheet

Sub PrintListOfAllBusyAppointments()
    Dim objStore As Store
    Dim objFolder As Folder
 
    dStart = InputBox("Enter the start date:", , Date)
    dEnd = InputBox("Enter the end date:", , Date + 30)
 
    Set objExcelApp = CreateObject("Excel.Application")
    Set objExcelWorkbook = objExcelApp.Workbooks.Add
    Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
    objExcelApp.Visible = True
 
    With objExcelWorksheet
         .Cells(1, 1) = "Subject"
         .Cells(1, 1).Font.Bold = True
         .Cells(1, 2) = "Location"
         .Cells(1, 2).Font.Bold = True
         .Cells(1, 3) = "Start"
         .Cells(1, 3).Font.Bold = True
         .Cells(1, 4) = "End"
         .Cells(1, 4).Font.Bold = True
         .Cells(1, 5) = "In Folder"
         .Cells(1, 5).Font.Bold = True
    End With
 
    For Each objStore In Application.Session.Stores
        For Each objFolder In objStore.GetRootFolder.Folders
            If objFolder.DefaultItemType = olAppointmentItem Then
               Call ProcessFolders(objFolder)
            End If
        Next
    Next
 
    objExcelWorksheet.Columns("A:E").AutoFit
    objExcelWorksheet.PrintOut
    objExcelWorkbook.Close False
    objExcelApp.Quit
End Sub

Sub ProcessFolders(ByVal objCurFolder As Folder)
    Dim strFilter As String
    Dim objItems As Outlook.Items
    Dim objRestrictedItems As Outlook.Items
    Dim objAppointment As AppointmentItem
    Dim nLastRow As Integer
    Dim objSubFolder As Folder
 
    Set objItems = objCurFolder.Items
    objItems.IncludeRecurrences = True
    objItems.Sort "[Start]"
 
    'Get the appointments in the specific date range
    strFilter = "[Start] >= " & Chr(34) & dStart & " 00:00 AM" & Chr(34) & " AND [End] <= " & Chr(34) & dEnd & " 11:59 PM" & Chr(34)
    Set objRestrictedItems = objItems.Restrict(strFilter)

    For Each objAppointment In objRestrictedItems
        If objAppointment.BusyStatus = olBusy Then
           nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1
 
           With objExcelWorksheet
                .Range("A" & nLastRow) = objAppointment.Subject
                .Range("B" & nLastRow) = objAppointment.Location
                .Range("C" & nLastRow) = objAppointment.Start
                .Range("D" & nLastRow) = objAppointment.End
                .Range("E" & nLastRow) = objCurFolder.FolderPath
           End With
        End If
    Next

    'Process all subfolders recursively
    If objCurFolder.Folders.Count > 0 Then
       For Each objSubFolder In objCurFolder.Folders
           Call ProcessFolders(objSubFolder)
       Next
    End If
End Sub

4. Kemudian, klik subrutin pertama dan tekan tombol “F5”.
5. Selanjutnya, Anda akan diminta untuk menentukan rentang tanggal untuk mencari janji.
6. Selanjutnya, klik "OK" untuk melanjutkan makro.
7. Terakhir, saat makro selesai, daftar janji temu sibuk dalam rentang tanggal yang telah ditentukan sebelumnya di semua folder kalender akan dicetak, seperti yang ditunjukkan pada gambar di bawah.

Atasi Korupsi Outlook yang Mengganggu

Jika Outlook Anda selalu ditutup dengan cara yang tidak tepat, Anda mungkin mengalami banyak masalah nanti. Di antara mereka, file Outlook yang rusak adalah yang terburuk. Jika Anda tidak ingin kehilangan data Anda, Anda perlu menggunakan alat perbaikan PST, seperti DataNumen Outlook Repair. Itu bisa mendapatkan kembali data maksimum dari Outlook rusak file.

Pengantar Penulis:

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