VBScript

指定したフォルダ内のemlファイルの情報をリスト化するVBScript

emlファイルから件名や本文、宛先や送信日時といった各種情報を取得して表にまとめる処理を考えてみました。

'******************************************************
' ドラッグ&ドロップしたフォルダ内にあるemlファイルの
' 情報をリスト化してExcelに出力するスクリプト
' 
' 2014/02/20 @kinuasa
'******************************************************

Option Explicit

Dim Args

Set Args = WScript.Arguments
'パラメータ数チェック
If Args.Count < 1 Then
  WScript.Echo "当スクリプトにフォルダをドラッグ&ドロップして処理を実行してください。"
  WScript.Quit
End If

'フォルダ判別
With CreateObject("Scripting.FileSystemObject")
  If .FolderExists(Args(0)) = False Then
    WScript.Echo "フォルダが見つかりません。" & vbCrLf & "あるいはフォルダではありません。"
    WScript.Quit
  End If
End With

'emlファイルの有無チェック
If IsExistsParticularFile(Args(0), "eml") = False Then
  WScript.Echo "指定したフォルダ内にemlファイルが見つかりませんでした。"
  WScript.Quit
End If

ListEmlFiles Args(0)
WScript.Echo "処理が終了しました。"

Private Sub ListEmlFiles(ByVal FolderPath)
'指定したフォルダ内のemlファイルの情報をリスト化(Excel)
  Dim exApp
  Dim exWb
  Dim exWs
  Dim msg
  Dim f
  Dim i
  
  Set exApp = CreateObject("Excel.Application")
  exApp.Visible = True
  Set exWb = exApp.Workbooks.Add
  Set exWs = exWb.Worksheets(1)
  i = 2 '初期化

  '見出し
  exWs.Cells(1, 1).Value = "No."
  exWs.Cells(1, 2).Value = "ファイル名"
  exWs.Cells(1, 3).Value = "件名"
  exWs.Cells(1, 4).Value = "本文"
  exWs.Cells(1, 5).Value = "送信者"
  exWs.Cells(1, 6).Value = "宛先"
  exWs.Cells(1, 7).Value = "CC"
  exWs.Cells(1, 8).Value = "BCC"
  exWs.Cells(1, 9).Value = "送信日時"
  exWs.Cells(1, 10).Value = "受信日時"
  exWs.Cells(1, 11).Value = "添付ファイル数"
  
  With CreateObject("Scripting.FileSystemObject")
    For Each f In .GetFolder(FolderPath).Files
      Select Case LCase(.GetExtensionName(f))
        'emlファイルのみ処理
        Case "eml"
          Set msg = GetMessage(f.Path)
          exWs.Cells(i, 1).Value = i - 1
          exWs.Cells(i, 2).Value = f.Name
          exWs.Cells(i, 3).Value = msg.Subject
          exWs.Cells(i, 4).Value = msg.TextBody
          exWs.Cells(i, 5).Value = msg.From
          exWs.Cells(i, 6).Value = msg.To
          exWs.Cells(i, 7).Value = msg.CC
          exWs.Cells(i, 8).Value = msg.BCC
          exWs.Cells(i, 9).Value = msg.SentOn
          exWs.Cells(i, 10).Value = msg.ReceivedTime
          exWs.Cells(i, 11).Value = msg.Attachments.Count
          Set msg = Nothing
          i = i + 1
      End Select
    Next
  End With
  exWs.Range(exWs.Rows(2), exWs.Rows(i - 1)).WrapText = False
End Sub

Private Function GetMessage(ByVal FilePath)
'emlファイルからMessage取得
  Dim stm
  Dim msg
  
  Set stm = CreateObject("ADODB.Stream")
  Set msg = CreateObject("CDO.Message")
  stm.Open
  stm.LoadFromFile FilePath
  msg.DataSource.OpenObject stm, "_Stream"
  stm.Close
  Set GetMessage = msg
End Function

Private Function IsExistsParticularFile(ByVal FolderPath, ByVal FileExtension)
'指定したフォルダ内に特定の拡張子のファイルがあるかを調べる
  Dim ret
  Dim f
  
  ret = False '初期化
  With CreateObject("Scripting.FileSystemObject")
    For Each f In .GetFolder(FolderPath).Files
      Select Case LCase(.GetExtensionName(f))
        Case LCase(FileExtension)
          ret = True
          Exit For
      End Select
    Next
  End With
  IsExistsParticularFile = ret
End Function

上記コードは、スクリプトファイルにドラッグ&ドロップしたフォルダ内にあるemlファイルの情報を、リスト化してExcelに出力する処理を行います。
メーラーに溜まったメールの情報をまとめるのに役立つスクリプトだと思います。

【編集後記】

Outlook以外のメーラーに溜まったメール情報を取得する必要があったので、上記のようなスクリプトを考えてみました。
CDOを使うと簡単にemlファイルから情報を抜き出せるので、とても便利ですね!
上記コードでは一部情報しか取得していませんが、コードを一部変更することにより他のメールヘッダー情報も抜き出せるようになります。

目次を更新するWordマクロ前のページ

以前のGoogle マップを使う。次のページ

関連記事

  1. Office関連

    ドラッグ&ドロップでExcelのアドインを登録するVBScript

    「ドラッグ&ドロップでWordのテンプレートを登録・解除する(VBS)…

  2. VBScript

    画像の一部にぼかしを入れるバッチ処理

    Paint.NETなどの画像処理ソフトを使うと、簡単に画像にぼかしを入…

  3. VBScript

    クリップボードに文字列をコピーする

    2012/4/3 追記:関連記事として「clipコマンドを利用してクリ…

  4. VBScript

    OWSPostDataオブジェクトを使って文字列をエンコードするVBS

    OWSPostDataオブジェクトのURLEncodeメソッドで文字列…

  5. Office関連

    Officeアプリケーションのバージョン情報ダイアログから情報を取得するVBScript

    自分の手間を減らすためのスクリプトシリーズ、今回はWordやExcel…

コメント

    • きわぞう
    • 2014年 5月 12日 12:54pm

     自分がやりたいと思っていたことが、ほぼ、そのままズバリと書いていただいてあって、非常に助かりました。

    > 上記コードでは一部情報しか取得していませんが、
    > コードを一部変更することにより他のメールヘッダー
    > 情報も抜き出せるようになります。

     上記のように書いて頂いています。
    Microsoft のどこかの頁に、プロパティ一覧が書いてあるのだろうと思って、探してみたのですが、探し方がヘタなのか、見つけることが出来ませんでした。
     URLを教えていただけると、大変嬉しいです。

     ちなみに、私が追加で入手したいと思っているデータは、 
    受信したメッセージのヘッダーに含まれるmessage-ID という項目です。
    メール送信サーバーの方で一意に振り当てる項目だと思うので、これを使って
    同じメールが重複していないか、確認したいと思っています。

    例:Message-ID:

  1. > きわぞうさん

    初心者備忘録管理人のきぬあさです。
    ご質問いただきましたメッセージの各プロパティの件についてですが、SubjectやCCといった基本的な情報以外のメール情報は、Fieldsプロパティから取得できるFieldオブジェクトから取得することができるかと思います。

    ・IMessage Interface
    http://msdn.microsoft.com/en-us/library/ms872547.aspx
    ・Fields Property
    http://msdn.microsoft.com/en-us/library/aa487625.aspx

    Message-IDの場合は下記のような感じですね。

    [msg.Fields(“urn:schemas:mailheader:message-id”).Value]

    ・urn:content-classes:message
    http://msdn.microsoft.com/en-us/library/aa123730.aspx

    • きわぞう
    • 2014年 6月 23日 3:47pm

    きぬあさ様

     すぐにご回答いただいていたのに、確認するのが遅くなってしまい、誠に申し訳ありませんでした。

     教えていただいた方法で、確かにmessage-id を取得することができました。

     本当にありがとうございました!

    • 新人です。
    • 2017年 4月 17日 10:50am

    きぬあさ様
    失礼致します。
    コードを拝見し使用したくTERAPADにて、vbs拡張子でスクリプト化した次第ですが、emlファイルをドロップすると「文字が正しくありません」のエラーが出てしまします。
    初歩的な事だと思いますが対応策を教えて戴けないでしょうか。

    • 新人です。様

      当ブログ管理人です。
      ご質問いただいた件につきまして、該当エラーメッセージが表示されるという事は、スクリプトのコピー&ペーストが上手くいっていない可能性があります。

      http://tooljp.com/language/VBScript/errorcode/VBScript-error-code-1032.html

      記事( https://www.ka-net.org/blog/?p=4044 )内のコード部分をダブルクリックすると、コードすべてが選択されるので、そのままコピー→TeraPadに貼り付けて「vbs」ファイルとして保存、そしてそのvbsファイルに“emlファイルが入ったフォルダ”をドラッグ&ドロップして、再度動作確認をしていただけますでしょうか。

    • 2017年 12月 15日 4:03pm

    エクセルに直接出力できてとても便利に利用させていただいています。
    しかし、受信したメールをeml形式で保存したものに対しては有効なのですが送信したメールの日付が取得できません。

    取得したいのは「送信日時」です。
    SentOnやReceivedTime は 0:00:00 と返してきました(送信メールが受信日時を返せないのはあたりまえかもしれませんが…)。

    参照するプロパティが違うのだと思ったのですが、自分なりに調べてみても分かりませんでした。
    WindowsLiveメールなどでは送信時間が表示されますので、emlファイル内に送信日時に相当する何かの情報が
    含まれているとは思うのですが…

    お知恵をお借りできると幸いです。

    • ぬ様

      当ブログ管理人です。
      ご質問いただいた件につきまして、手元の環境では送信済みのメールであってもSentOnプロパティで取得できたのですが、一度Fieldオブジェクト経由での取得も試してみてはいかがでしょうか?

      msg.Fields(“urn:schemas:httpmail:date”).Value

      ・urn:content-classes:message
      http://msdn.microsoft.com/en-us/library/aa123730.aspx

    • 2017年 12月 26日 8:42pm

    せっかく教えて頂いたのに、やはり取得できませんでした。

    ただ、(確定ではないですが自分で試した範囲で)原因はわかりました。

    ヘッダの一番最初がDateフィールドだと上手く取得できないようです。
    テキストエディタでヘッダの順番を並び替えるだけで取得可能になりました。

    ですので雑ですが「Received: 」を一行目に追加することで回避しました。

    ありがとうございました。

  1. この記事へのトラックバックはありません。

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP