Belirli Bir Tarih Aralığındaki Tüm Meşgul Randevuların Listesini Outlook VBA ile Yazdırma

Bu makale, "Meşgul" olarak gösterilen ve belirli bir tarih aralığında planlanan tüm randevuların listesini yazdırmanın kolay bir yöntemini öğretecektir.

Belirli bir tarih aralığındaki tüm meşgul randevuları bulmak için tüm takvimlerde döngü oluşturmak oldukça kolaydır. Arama kapsamını "Tüm Takvim Öğeleri" olarak ayarlayabilirsiniz. Ardından, "Zamanı Göster" seçeneği "Meşgul" olan ve belirli başlangıç ​​ve bitiş tarihleri ​​arasında olan randevuları arayın. Ancak, bu şekilde, bulunan randevuları yazdırmak istediğinizde ve "Dosya" > "Yazdır" seçeneğine gittiğinizde, yalnızca "Not Stili"nin mevcut olduğunu göreceksiniz. Bu, bulunan randevuları liste halinde yazdıramayacağınız anlamına gelir. Bu nedenle, bu tür randevuların listesini yazdırmak istiyorsanız, aşağıdaki yöntemi kullanabilirsiniz.

Belirli Bir Tarih Aralığındaki Tüm Meşgul Randevuların Listesini Yazdır

1. En başta, "Alt + F11" aracılığıyla Outlook VBA düzenleyicisini başlatın.
2. Ardından, açılan “Microsoft Visual Basic for Applications” penceresinde, “MS Excel Object Library” referansını aşağıdaki şartlara uygun olarak ekleyin:VBA'da Nesne Kütüphanesi Referansı Nasıl Eklenir?".
3. Bundan sonra, aşağıdaki VBA kodunu bir modüle yerleştirin.

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. Daha sonra ilk alt programa tıklayın ve “F5” tuşuna basın.
5. Ardından, randevu aramak için tarih aralığını belirtmeniz istenecektir.
6. Daha sonra, makroya devam etmek için “Tamam”a tıklayın.
7. Son olarak, makro bittiğinde, aşağıdaki ekran görüntüsünde gösterildiği gibi, tüm takvim klasörlerinde önceden tanımlanmış tarih aralığındaki meşgul randevuların listesi yazdırılacaktır.

Rahatsız Edici Görünüm Bozulmasıyla Mücadele Edin

Outlook'unuz her zaman uygunsuz bir şekilde kapatılırsa, daha sonra birçok sorunla karşılaşabilirsiniz. Bunlar arasında Outlook dosyasının bozuk olması en kötüsüdür. Verilerinizi kaybetmek istemiyorsanız, örneğin bir PST düzeltme aracı kullanmanız gerekir. DataNumen Outlook Repair. Maksimum veriyi geri alabilir hasarlı görünüm dosyası.

Yazar Tanıtımı:

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