outlookのメール一覧をExcelに貼り付けるためのVBScriptを作ってみた

前回の記事で、outlookから msgファイルと添付ファイルを抽出するVBScriptを公開したが、その応用編として、メールの件名や内容の一覧をExcelに貼り付けるVBScriptを作成したので公開する。
スクリプトの大半は前回のものの流用であるが、添付ファイルやWindowsのフォルダを扱わないのでこちらの方がシンプルである。

それでは、まず仕様から。

• outlook上の特定メールフォルダに格納されているメールを対象とする。従って、実行前に対象メールを「特定メールフォルダ」にコピーする必要がある。
  【2019年5月2日追記】
  対象メールを「outlookで選択されているメール」に改良したバージョンを作成したので、興味のある方は本記事の文末を参照。
• 本スクリプトではExcelへの貼り付け自体は行わず、タブ区切りの一覧をクリップボードにコピーするまでを行う。従って、本スクリプトを実行した後、Excelの任意のセルを選択して貼り付け操作をすれば一覧がExcelに展開される。
• 貼り付けられる項目は、受信日時、件名、送信者、本文 とした。

以下、本スクリプトの利用手順である。

1. 対象ファイルを outlookの受信フォルダ直下の「export」フォルダにコピーする。フォルダ名はスクリプトの10行目で定義しており変更は可能だが、事前に決めておく必要がある。
2. 本スクリプトをダブルクリックで実行する。
3. outlookへのアクセス許可を求める以下のダイアログが表示されるので、「許可」を選択する。
   
   　
4. Excelの任意のセルを選択し、貼り付け操作（Control-vなど）を行う。
   　

テストした環境は Windows7と Office2010の組合せのみなのであしからず。
スクリプト（コードはSJIS）は以下のリンクからご自由に。（右クリックして保存）

「outlook2tsv.vbs」をダウンロード

読みにくいが、内容は以下の通り。

---

Option Explicit

Dim objOA, objNS, objOLFolder, objItm, objWS
Dim Mystring

Const olFolderInbox = 6
Const ErrNoOLFolder = -2147221233

'outlook の対象フォルダ名（受信トレイの下）
Const oLFolderName = "export"

Mystring = "受信日時" & vbTab & "件名" & vbTab & "送信者"& vbTab & "本文" & vbCrLf

Set objOA = CreateObject("Outlook.Application")
Set objNS = objOA.GetNamespace("MAPI")

Err.clear
On Error Resume Next

Set objOLFolder = objNS.GetDefaultFolder(olFolderInbox).Folders(oLFolderName)

If (Err.Number = ErrNoOLFolder) Then
  MsgBox "指定した outlook のフォルダ " & oLFolderName & " が存在しません"
  WScript.Quit
End If

On Error Goto 0

For Each objItm In objOLFolder.Items
  Mystring = Mystring & objItm.ReceivedTime & vbTab & objItm.Subject & vbTab & objItm.Sender & vbTab & """" & objItm.Body & """" & vbCrLf
Next

Set objWS = CreateObject("WScript.Shell")
objWS.Exec("clip").StdIn.Write Mystring

---

では。

【2019年5月2日追記】

以下の改良を行ったバージョンを作成したので、興味のある方は下記リンクから。（右クリックして保存）

• 対象メールを「outlookの特定メールフォルダ下にあるメール」から「outlook上で選択されているメール」に変更
• メール本文がHTML形式の場合、異常終了する不具合に対応（ただし、HTML形式の場合、 "?"などの不正文字が残ることがある）

ダウンロード - export_mails_from_outlook_in_tsv_format.vbs