Cara Mencetak Senarai Semua Temujanji Sibuk dalam Julat Tarikh Tertentu melalui Outlook VBA

Artikel ini akan mengajar anda kaedah mudah untuk mencetak daftar semua janji temu yang ditunjukkan sebagai "Sibuk" dan dijadualkan dalam rentang tarikh tertentu.

Agak mudah untuk menyemak semula semua kalendar untuk mencari semua temu janji sibuk dalam julat tarikh tertentu. Anda hanya boleh menetapkan skop carian kepada “Semua Item Kalendar”. Kemudian, cari temu janji dengan “Tunjukkan Masa Sebagai” bersamaan dengan “Sibuk” dan dalam tarikh mula dan tarikh tamat tertentu. Tetapi, dengan cara ini, apabila berhasrat untuk mencetak temu janji yang ditemui dan pergi ke “Fail” > “Cetak”, anda dapat melihat bahawa hanya terdapat “Gaya Memo” yang tersedia. Ini bermakna anda tidak boleh mencetak temu janji yang ditemui dalam senarai. Jadi, jika anda ingin mencetak senarai temu janji tersebut, anda boleh menggunakan cara berikut.

Cetak Senarai Semua Temujanji Sibuk dalam Julat Tarikh Tertentu

1. Pada awalnya, lancarkan editor Outlook VBA melalui "Alt + F11".
2. Kemudian, dalam tetingkap timbul “Microsoft Visual Basic for Applications”, tambahkan rujukan kepada “MS Excel Object Library” mengikut “Cara Menambah Rujukan Perpustakaan Objek dalam VBA".
3. Selepas itu, masukkan kod VBA berikut 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 butang kekunci "F5".
5. Seterusnya, anda diminta untuk menentukan julat tarikh untuk mencari janji temu.
6. Selepas itu, klik "OK" untuk meneruskan makro.
7. Akhirnya, apabila makro selesai, senarai janji temu yang sibuk dalam julat tarikh yang telah ditentukan di semua folder kalendar akan dicetak, seperti yang ditunjukkan dalam tangkapan skrin di bawah.

Tangani Rasuah Mengganggu Outlook

Sekiranya Outlook anda selalu ditutup dengan cara yang tidak betul, anda mungkin akan menghadapi banyak masalah kemudian. Antaranya, fail Outlook yang rosak adalah yang terburuk. Sekiranya anda tidak mahu kehilangan data anda, anda perlu menggunakan alat memperbaiki PST, seperti DataNumen Outlook Repair. Ia dapat mendapatkan kembali data maksimum dari Outlook yang rosak fail.

Pengenalan Pengarang:

Shirley Zhang adalah pakar pemulihan data di DataNumen, Inc., yang merupakan pemimpin dunia dalam teknologi pemulihan data, termasuk memperbaiki sql dan produk perisian pembaikan prospek. Untuk maklumat lebih lanjut, lawati www.datanumen.com