OutlookVBAを介して特定の日付範囲内のすべてのビジーアポイントメントのリストを印刷する方法

Outlookソリューション 2025 年 9 月 29 日

この記事では、「ビジー」と表示され、特定の日付範囲でスケジュールされているすべての予定のリストを印刷する簡単な方法を説明します。

特定の日付範囲で予定が入っている予定をすべて見つけるには、すべてのカレンダーをループ処理するのは非常に簡単です。検索範囲を「すべてのカレンダー項目」に設定するだけです。次に、「時刻の表示方法」が「予定あり」で、特定の開始日と終了日の範囲内の予定を検索します。しかし、この方法で見つかった予定を印刷しようとして「ファイル」>「印刷」を選択すると、「メモ形式」しか選択できないことがわかります。つまり、見つかった予定をリスト形式で印刷することはできません。そのため、そのような予定をリスト形式で印刷したい場合は、次の方法を使用できます。

特定の日付範囲内のすべてのビジーアポイントメントのリストを印刷します

最初に、「Alt + F11」を使用してOutlookVBAエディターを起動します。
次に、ポップアップウィンドウ「Microsoft Visual Basic for Applications」で、「MS Excel Object Library」への参照を次のように追加します。VBAでオブジェクトライブラリ参照を追加する方法"
その後、次のVBAコードをモジュールに入れます。

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

後で、最初のサブルーチンをクリックして、「F5」キーボタンを押します。
次に、予定を検索する日付範囲を指定する必要があります。
続いて、「OK」をクリックしてマクロを続行します。
最後に、マクロが終了すると、以下のスクリーンショットに示すように、すべてのカレンダーフォルダーの事前定義された日付範囲内のビジーアポイントメントのリストが印刷されます。

不穏な見通しの腐敗に取り組む

Outlookが常に不適切な方法で閉じられている場合、後で多くの問題が発生する可能性があります。それらの中で、破損しているOutlookファイルは最悪のものです。データを失いたくない場合は、次のようなPST修正ツールを使用する必要があります DataNumen Outlook Repair。から最大のデータを取り戻すことができます破損したOutlook ファイルにソフトウェアを指定する必要があります。

著者紹介：

Shirley Zhangは、のデータ復旧の専門家です。 DataNumen、Inc。は、以下を含むデータ復旧技術の世界的リーダーです。 SQL修正と見通し修理ソフトウェア製品。詳細については、次のWebサイトをご覧ください。 WWW。datanumen.com