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

以前、「Outlook の予定表を CSV ファイルにエクスポートするマクロ」や「Exchange 環境で共有されている他人の予定表のデータを取得するマクロ」として、予定表を CSV ファイルに出力するマクロを公開していたのですが、開始日時や終了日時を日付と時間に分けて出力する方法についてのご質問をいただきました。

そこで、以前公開したバージョンの改訂版として開始日時を日付と時間に分けたものを作成しました。

以下がそのマクロです。ExportMyCalendar は自分の予定を、ExportOthersCalendar は Exchange 環境で共有されている他人の予定を CSV に出力するマクロです。

'ここをトリプル クリックするとマクロ全体が選択できます。
'  自分の予定表を出力するマクロ
Public Sub ExportMyCalendar()
    Const MY_CSV_FILE_NAME = "c:\mycalendar.csv" ' エクスポートするファイル名を指定してください。
    Dim fldCalendar ' As Folder
    Set fldCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)
    ExportThisMonth fldCalendar, MY_CSV_FILE_NAME
End Sub
'  他人の予定を出力するマクロ
Public Sub ExportOthersCalendar()
    Const OTHERS_CSV_FILE_NAME = "c:\others.csv" ' エクスポートするファイル名を指定してください。
    Dim strUserName As String
    Dim objRecip As Recipient
    Dim fldCalendar 'As Folder
    strUserName = InputBox("ユーザー名またはアドレスを入力してください", "共有されている予定表のエクスポート")
    Set objRecip = Application.Session.CreateRecipient(strUserName)
    objRecip.Resolve
    If Not objRecip.Resolved Then
        MsgBox "ユーザーが特定できませんでした。", vbCritical, "共有されている予定表のエクスポート"
        Exit Sub
    End If
    Set fldCalendar = Application.Session.GetSharedDefaultFolder(objRecip, olFolderCalendar)
    ExportThisMonth fldCalendar, OTHERS_CSV_FILE_NAME
End Sub
'  共通ルーチンです。必ずこちらもコピーしてください。
Public Sub ExportThisMonth( fldCalendar, strFileName As String )
    Dim strStart As String
    Dim strEnd As String
    Dim dtExport As Date
    Dim objFSO 'As FileSystemObject
    Dim stmCSVFile 'As TextStream
    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 = DateAdd("m", 1, CDate(strStart)) & " 00:00"
    '
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set stmCSVFile = objFSO.CreateTextFile(strFileName, True)
    ' CSV ファイルのヘッダです。出力するフィールドを増減する場合はこちらも変更してください。
    stmCSVFile.WriteLine """件名"",""場所"",""開始日"",""開始時刻"",""終了日"",""終了時刻"",""分類項目"",""主催者"",""必須出席者"",""任意出席者"""
    Set colAppts = fldCalendar.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 & _
            """,""" & FormatDateTime(objAppt.Start, vbShortDate) & _
            """,""" & FormatDateTime(objAppt.Start, vbShortTime) & _
            """,""" & FormatDateTime(objAppt.End, vbShortDate) & _
            """,""" & FormatDateTime(objAppt.End, vbShortTime) & _
            """,""" & objAppt.Categories & _
            """,""" & objAppt.Organizer & _
            """,""" & objAppt.RequiredAttendees & _
            """,""" & objAppt.OptionalAttendees & _
            """"
'
       stmCSVFile.WriteLine strLine
        Set objAppt = colAppts.FindNext
    Wend
    stmCSVFile.Close
End Sub


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