Outlookのメールの内容を抽出

Outlookのメールを手作業で抜き出しデスクトップ上のフォルダに入れた後、そのフォルダ内のメールの受信日とある文字列以降（工場Ｎｏ：　管理Ｎｏ：　項目Ｎｏ：）の文字列（数字かアルファベット4ケタのコード）を抽出しエクセル上に日付順に出力出来るＶＢＡを組みたいのですが、同じようなＶＢＡが無いか検索して見ましたが参考に出来る（理解出来る）ような情報が無かったため質問させていただいています。
環境は共に2010を使用しています。

No.1 回答者： queuerev2 回答日時： 2013/08/16 22:17

どのあたりの解説をお望みでしょうか。

フォルダ内のメールを扱う方法でしょうか、メールから情報を抽出するところでしょうか。
フォルダがOutlookのフォルダではなくデスクトップつまりWindowsのファイルシステムのフォルダなので、そのあたりがよくわからないということでしょうか。
とりあえずはそこのところを解説します。

デスクトップのフォルダの中のメールということは、拡張子が.msgのファイルですね。
これをOutlook VBAで開く方法を調べてみたのですが、意外な事にVBAで.msgファイルを開く素直な方法はなさそうで、複数の情報があった方法は以下の２つでした。

１．CreateItemFromTemplate メソッドを使う方法
Outlook.ApplicationのCreateItemFromTemplate メソッドを使います。
この方法はメールを開くのではなく、メールをひな形として新しいメールを作るものです。
そのため、元のファイルに書き戻すことはできませんし、一部取り出せない情報もあるようです。しかし今回の用途にはこれが適していると思われます。

２．Shellから.msgファイルを開く方法
VBAのShell関数などを使ってOUTLOOK.EXEを/fと.msgファイルの２つの引数を与えて実行する方法です。（.msgファイル単体で開く方法もあります）
変更内容を書き戻すならこの方法しかないと思いますが、開いただけではMailItemオブジェクトは得られず、VBAで編集ウィンドウ (Inspector) を探さなければならないので、手順が煩雑なうえ不安定になる可能性があります。今回は書き戻す必要はないと思いますので不採用とします。

以下、デスクトップの"MSGS"というフォルダに.msgファイルが入っているとして、ファイルから受信日時を抽出してアクティブなワークシートのA列に出力するExcel VBAのサンプルコードを示します。
簡単のため、ファイルはすべて.msgファイルであるとし、本文や件名からの情報抽出は省略します。

Sub Sample1()
Dim oOL As Object, MI As Object
Dim oWShell As Object, oFSO As Object
Dim mFs As String
Dim RowAdr As Long
Dim e As Variant
Set oOL = CreateObject("Outlook.Application")
Set oWShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
mFs = oWShell.SpecialFolders("Desktop") & "\MSGS"
RowAdr = 1
For Each e In oFSO.getfolder(mFs).Files
Set MI = oOL.CreateItemFromTemplate(e.Path)
Cells(RowAdr, 1) = MI.ReceivedTime
RowAdr = RowAdr + 1
MI.Close 1 'olDiscard
Next
End Sub

ところで、フォルダはデスクトップ上ではなくOutlookのフォルダにしてはいかがでしょうか。もしOutlookのフォルダにすればVBAがもう少し簡単になります。
抜き出したメールが"個人用フォルダ"のサブフォルダ"MSGS"にあるとして例を示します。
Sub Sample2()
Dim oOL As Object, NS As Object
Dim ExFolder As Object
Dim RowAdr As Long
Dim e As Variant
Set oOL = CreateObject("Outlook.Application")
Set NS = oOL.GetNamespace("MAPI")
Set ExFolder = NS.Folders("個人用フォルダ").Folders("MSGS")
RowAdr = 1
For Each e In ExFolder.Items
Cells(RowAdr, 1) = e.ReceivedTime
RowAdr = RowAdr + 1
Next
End Sub

動作確認はOffice2007, WindowsXPで行いましたが、おそらくOffice2010でも大丈夫だと思います。

疑問点や他の部分の解説希望等ありましたら補足ください。

この回答へのお礼

　回答ありがとうございます上記のとおり、Windowsのファイルシステムのフォルダから抽出方法がベストですが、調べても出てきませんでした。フォルダからの理由としてOutlookのフォルダから毎日読み込むため抽出データが重複してしまうと思っていたからです。フォルダ指定が出来るのであれば上記のマクロを利用して再度挑戦してみます。

お礼日時：2013/08/19 21:20