Outlook の予定表を CSV ファイルにエクスポートするマクロ

Outlook のエクスポートを使えば、予定表を CSV ファイルにエクスポートできますが、定期的にエクスポートを実施したいような場合、毎回エクスポート ウィザードを使うのはわずらわしいと感じる方もいるかもしれません。

そこで、以下のようなマクロを作ってみました。このマクロは今月の予定を C:\thismonth.csv に保存するというものです。保存先などを変更してツールバーにマクロを登録しておけば、ワンクリックでエクスポートできるようになります。 

---

' 今月の予定をエクスポートするマクロ
' ここをトリプル クリックするとマクロ全体が選択できます。
Public Sub ExportThisMonthCalendar()
    Dim dtExport As Date
    Dim strStart As String
    Dim strEnd As String
    Dim objFSO 'As FileSystemObject
    Dim stmCSVFile 'As TextStream
    Const CSV_FILE_NAME = "c:\thismonth.csv" '' エクスポートするファイル名を指定してください。
    Dim colAppts As Items
    Dim objAppt 'As AppointmentItem
    Dim strLine As String
    dtExport = Now ' 来月の予定をエクスポートする場合は Now の代わりに DateAdd("m",1,Now) を使用します。
    ' 月単位ではなく任意の単位にする場合は以下の記述を変更します。
    strStart = Year(Now) & "/" & Month(Now) & "/1 00:00"
    ' エクスポートする範囲の最後の日の次の日を strEnd に指定します。
    strEnd = DateAdd("m", 1, CDate(strStart)) & " 00:00"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set stmCSVFile = objFSO.CreateTextFile(CSV_FILE_NAME, True)
    ' CSV ファイルのヘッダです。出力するフィールドを増減する場合はこちらも変更してください。
    stmCSVFile.WriteLine """件名"",""場所"",""開始日時"",""終了日時"",""分類項目"",""主催者"",""必須出席者"",""任意出席者"""
    Set colAppts = Application.Session.GetDefaultFolder(olFolderCalendar).Items
    colAppts.Sort "[Start]"
    colAppts.IncludeRecurrences = True
    Set objAppt = colAppts.Find("[Start] < """ & strEnd & """ AND [End] >= """ & strStart & """")
    While Not objAppt Is Nothing
        strLine = """" & objAppt.Subject & _
            """,""" & objAppt.Location & _
            """,""" & objAppt.Start & _
            """,""" & objAppt.End & _
            """,""" & objAppt.Categories & _
            """,""" & objAppt.Organizer & _
            """,""" & objAppt.RequiredAttendees & _
            """,""" & objAppt.OptionalAttendees & _
            """"
        stmCSVFile.WriteLine strLine
        Set objAppt = colAppts.FindNext
    Wend
    stmCSVFile.Close
End Sub

---

マクロの登録方法やメニューへの追加について