【Excel VBA】Outlookの予定表をExcelの一覧表に出力する(CSVエクスポートなし)

Outlookに登録してある予定表のデータをExcelに一覧形式で取り込みたいのです。
以前、VBAを使ってメールの件名一覧を作ったことがあったので、カレンダーもなんとかなるだろうという発想でした。
ちなみに、メール操作のコードは過去のものとして、どこかに消えていってしまいました。きっと偉い人に接収されたのだと思いますw

昔のことを思い出しながら、可能なことだとは分かっていながら、とりあえずの対策ということでOutlookマクロでCSVを吐き出させていました。
ここのところでまとまった時間があったような気がしたので、改めて調べながらマクロを書きました。
今度はなくさないように備忘録を残します!w

それにしても、Excel VBAは便利ですね。
その分危険なこともあるということは肝に銘じておきましょう。

Outlookオブジェクトを呼ぶ

オブジェクトを呼び、名前空間を呼び、フォルダーを開いて、予定の配列を引っ張り出す、みたいなことです。
あちこちのサイトを見比べて、イケてるコードをいただいてきました。

Outlookマクロも参考にしています。オブジェクトの定義がExcelとは異なるのです。

ぶっちゃけ、詳細は分からないところもあります。
魔法の言葉ということで使っていますw
以前もそうだったので、大丈夫だと思います。毎月お世話になっていました。そしてこれからもお世話になるのです。

書いたコード

書いたコードのデフォルメは以下のとおりです。
実際には、シートオブジェクトを指定して、取得対象の日付範囲は動的に変わるようにしました。

このコードの実行には、参照設定が必要です。
VBAの画面の「ツール」→「参照設定」から、「Microsoft Outlook 14.0 Object Library」をオンにします。

サンプルコード

Sub getOutlookCalenderItems()
    ' Outlookオブジェクト
    Dim objOLApp ' As Outlook.Application
    Set objOLApp = CreateObject("Outlook.Application")
    ' Outlook名前空間
    Dim nmsOLApp ' Outlook.NameSpace
    Set nmsOLApp = objOLApp.GetNamespace("MAPI")
    ' 予定表フォルダー
    Dim fldCalendar ' Outlook.Folder
    Set fldCalendar = nmsOLApp.GetDefaultFolder(olFolderCalendar)
    ' 予定
    Dim colAppts ' As Items
    Set colAppts = fldCalendar.Items
    colAppts.Sort "[Start]"
    colAppts.IncludeRecurrences = True
    ' 個々の予定
    Dim objAppt ' As AppointmentItem
    Set objAppt = colAppts.Find("[Start] < ""2017/7/1"" AND [End] >= ""2017/6/1""") ' ★
    ' -- 転記
    Dim lngRowCount As Long
    Dim objSheet As Object
    Set objSheet = ThisWorkbook.Sheets(1)
    With objSheet
        .Cells(1, 1).Value = "開始日"
        .Cells(1, 2).Value = "開始時刻"
        .Cells(1, 3).Value = "終了時刻"
        .Cells(1, 4).Value = "件名"
        .Cells(1, 5).Value = "場所"
        .Cells(1, 6).Value = "内容"
        lngRowCount = 2
        While Not objAppt Is Nothing
            .Cells(lngRowCount, 1).Value = FormatDateTime(objAppt.Start, vbShortDate)
            .Cells(lngRowCount, 2).Value = FormatDateTime(objAppt.Start, vbShortTime)
            .Cells(lngRowCount, 3).Value = FormatDateTime(objAppt.End, vbShortTime)
            .Cells(lngRowCount, 4).Value = objAppt.Subject
            .Cells(lngRowCount, 5).Value = objAppt.Location
            .Cells(lngRowCount, 6).Value = objAppt.Body
            ' 次のアイテム
            Set objAppt = colAppts.FindNext
            lngRowCount = lngRowCount + 1
        Wend
    End With
    '
    Set objAppt = Nothing
    Set colAppts = Nothing
    Set fldCalendar = Nothing
    Set nmsOLApp = Nothing
    Set objOLApp = Nothing
End Sub

時刻まで指定

上記のサンプルコード内の「★」マーク部分で、時刻まで指定する書き方は以下のとおりです。
時刻の前に半角スペースを入れるだけです。

    Set objAppt = colAppts.Find("[Start] < ""2017/7/1 5:00"" AND [End] >= ""2017/6/1 5:00""")

範囲を変数化

上記サンプルコード内の「★」マーク部分で、変数を利用した書き方は以下のとおりです。
上述のとおり、ダブルクォーテーションのエスケープがやっかいです。

    Set objAppt = colAppts.Find("[Start] < """ & 変数1 & """ AND [End] >= """ & 変数2 & """")

実際のところは、毎月範囲が変わりますので、こちらで運用しております。

日付時刻で範囲指定が可能

AppointmentItemFind で、開始と終了を文字列指定できます。
実際に書いたコードでは、日付を動的に代入する文字列型変数をアンパサンドで繋ぎました。
その際は、ダブルクォーテーションのエスケープ方法にご注意を。

範囲指定をしないと、登録してある予定を最初から全件出力することになります。
場合によっては相当な数になって激しいループに陥るので注意が必要です。

細かい設定方法などは、個別にMSDNで調べられます。

Excel

これで、Outlook側で稼働させていたマクロは不要になりました。
Excelに一本化できて便利です♪

この投稿を書いたのは・・・
Blog Master

ガジェットが大好きで、毎月何かしら買っております。
無駄遣い扱いされたくないのと、何かの役に立つかと思い、記録を書くことにしたのでした。

お出かけのときには、スマホを複数台とタブレットとパソコンと、Pocket WiFiを持ち歩きます。
両手首にはスマートウォッチです。
こんなスタイルで生活している中での備忘録を書いています。

「Blog Master」をフォローしてみる
Excel関連
「Blog Master」をフォローしてみる
wnkhs.net

コメント

  1. 中嶋一郎 より:

    こんにちはーー お世話になります。
    excel vbaでoutlookの予定表を読み出すことWおトライしてみました。
    面白いですね。
    教えてほしいことは会社では複数の社員の予定表が見えますがその情報をEXCEL VBAで抽出するにはどこを修正すればよろしいのでしょうか?
    よろしくお願いいたします。

タイトルとURLをコピーしました