« ♪Piano | トップページ | ▼ダイエット大作戦(近頃だいぶメタボ) »

2007年3月31日 (土)

◆Outlook VBA(Outlookメール情報をExcel一覧化)

VBAの話題は久しぶりになりますが、今回はOutlook VBAについて書いてみます。

OutlookでVBAってちょっとマイナーな気がしますが皆さんはいかがでしょうか?ネット上でも話題は少ない気がします。Outlookと自動化はあまり関係が無いような感じです。自分自身でもあまりアイデアがありません。

とっかかりとして、こんなことが出来るのだというところで、選択したメールの情報をExcelの一覧にしてみます。メールの内容をExcelで管理できるようになるので何かと便利です。以下がその例です。

Sub 選択メールの情報をExcel一覧化( )
    Dim myOlApp As New Outlook.Application
    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection
    Dim MsgTxt As String, a As String
    Dim Files As Variant, oF As Variant
    Dim myExlApp As Object, oNewWb As Object, oSel As Object
    Dim i As Integer, j As Integer
    Dim lSubject As String
    Dim lMsg As String
    Dim lSentOnBehalfOfName As String
    Dim lSenderName  As String
    Dim lReceivedByName  As String
    Dim lReceivedOnBehalfOfName   As String
    Dim lReplyRecipientNames  As String
    Dim lTo  As String
    Dim lCC  As String
    Dim lBCC  As String
    Dim lCreationTime  As String
    Dim lSize  As Long
    Dim lsenderemailaddress  As String
    Dim lTempFile  As String
      
    Set myOlApp = CreateObject("Outlook.Application")
    Set myOlExp = myOlApp.ActiveExplorer
    Set myOlSel = myOlExp.Selection
   
    '新規ブック作成
    Set myExlApp = CreateObject("excel.Application")
    Set oNewWb = myExlApp.workbooks.Add
    '一覧整形
    myExlApp.ActiveWindow.Zoom = 85
    With oNewWb.sheets(1)
        .Cells.WrapText = True
       
        .Range("A1:N1") = Array("件名", "本文", "添付ファイル", "受信日時", "サイズ", "送信者表示名", "送信者", "受信者表示名", "受信者", "", "TO", "CC", "BCC", "送信者Address")
        .Columns("A:A").ColumnWidth = 32
        .Columns("B:B").ColumnWidth = 40
        .Columns("D:D").ColumnWidth = 15.71
        .Columns("K:k").ColumnWidth = 15.71
        .Rows("2:2").Select
    End With
    myExlApp.ActiveWindow.FreezePanes = True
    With oNewWb.sheets(1)
        .Range("A1").Select
    End With
   
    i = 1
    '選択されているメールの添付ファイルを保存
    For Each oSel In myOlSel
       
        lSubject = oSel.Subject
        lMsg = oSel.Body
        lSentOnBehalfOfName = oSel.SentOnBehalfOfName
        lSenderName = oSel.SenderName
        lReceivedByName = oSel.ReceivedByName
        lReceivedOnBehalfOfName = oSel.ReceivedOnBehalfOfName
        lReplyRecipientNames = oSel.ReplyRecipientNames
        lTo = oSel.To
        lCC = oSel.CC
        lBCC = oSel.BCC
        lCreationTime = oSel.ReceivedTime
        lSize = oSel.Size
        lsenderemailaddress = oSel.senderemailaddress
      
        lTempFile = ""
        For Each oF In oSel.Attachments
            lTempFile = lTempFile & oF.DisplayName & Chr(10)
            j = j + 1
        Next
       
        i = i + 1
       
        oNewWb.sheets(1).Cells(i, 1).Value = lSubject
        oNewWb.sheets(1).Cells(i, 2).Value = lMsg
        oNewWb.sheets(1).Cells(i, 3).Value = lTempFile
        oNewWb.sheets(1).Cells(i, 4).Value = lCreationTime
        oNewWb.sheets(1).Cells(i, 5).Value = Format(Int(lSize / 1024), "##,###") & "KB"
        oNewWb.sheets(1).Cells(i, 6).Value = lSentOnBehalfOfName
        oNewWb.sheets(1).Cells(i, 7).Value = lSenderName
        oNewWb.sheets(1).Cells(i, 8).Value = lReceivedByName
        oNewWb.sheets(1).Cells(i, 9).Value = lReceivedOnBehalfOfName
        oNewWb.sheets(1).Cells(i, 10).Value = lReplyRecipientNames
        oNewWb.sheets(1).Cells(i, 11).Value = lTo
        oNewWb.sheets(1).Cells(i, 12).Value = lCC
        oNewWb.sheets(1).Cells(i, 13).Value = lBCC
        oNewWb.sheets(1).Cells(i, 14).Value = lsenderemailaddress
       
    Next

    myExlApp.Visible = True
   
p_Error:
    Set oF = Nothing
    Set oSel = Nothing
    Set myExlApp = Nothing
    Set oNewWb = Nothing
    Set myOlApp = Nothing
    Set myOlExp = Nothing
    Set myOlSel = Nothing
    MsgBox "終了しました。総数:" & i - 1
End Sub

では解説してみましょう。CreateObject("Outlook.Application")でOutlookオブジェクトを生成します。選択したメールをSet myOlSel = myOlExp.Selectionで取得します。

次にSet myExlApp = CreateObject("excel.Application")でExcelオブジェクトを生成します。For Each oSel In myOlSelで選択したメール1件ずつ繰り返し処理します。メールの情報は以下のものを取得しています。詳しくはVBAヘルプで確認してみてください。

    件名               oSel.Subject
    本文               oSel.Body
    受信日時         oSel.ReceivedTime
    サイズ               oSel.Size
    送信者表示名   oSel.SentOnBehalfOfName
    送信者            oSel.SenderName
    受信者表示名   oSel.ReceivedByName
    受信者            oSel.ReceivedOnBehalfOfName
    TO                  oSel.To
    CC                 oSel.CC
    BCC               oSel.BCC
    送信者Address oSel.senderemailaddress

ざっくりこれが処理の説明ですが、ここから重要です。

この処理を何処に書けばよいでしょうか。Excelとほぼ同じですが、メニュー「ツール」→「マクロ」→「Visual Basic Editor」→VbaProject.OTMに標準モジュールを追加して処理を記述します。しかし、Excelはブック毎にVBAProjectが存在しますが、OutlookではVbaProject.OTMが唯一のプロジェクトです。

これでメニュー「ツール」→「マクロ」→「マクロ」→「選択メールの情報をExcel一覧化」で実行できるわけですが、実際に実行するとOutlook VBAに慣れていない方は多少驚きと煩わしさを感じることでしょう(始めは私もそうでした)。それは、セキュリティの問題です。昨今のウィルスによるメール大量送付は大抵このVBAや親戚(?)のWSHによるものなので、VBAを実行するといちいち以下のような防御のメッセージが表示されます。「アクセスを許可する時間」で指定した時間内はかろうじてVBA処理が許可されるしくみです。最大10分まで選択できるので選択して「はい」で実行することができます。

Outlook

長くなりましたので今回はここまでとします。次回はOutlookのカスタマイズと配布方法について書いてみます。

※私が作成したVBAツールです。よかったら使ってみてください。

« ♪Piano | トップページ | ▼ダイエット大作戦(近頃だいぶメタボ) »

パソコン・インターネット」カテゴリの記事

コメント

VBAはあまり詳しくないので、教えて下さい。

本記事内容を実行してみると、数件のメールであれば旨く変換できるのですが、各々のメールの容量にもよるのかも知れませんが、選択するメールの件数が多くなると、「実行時ケラー”7”メモリが不足しています」と表示されます。ここで[デバッグ]をクリックすると、リストの75行前後で止まっています。
  oNewWb.sheets(1).Cells(i, 2).Value = lMsg
◆つきましては、この様なエラーが出ないようにするには、どの様にしたら良いでしょうか。

◆また、エラーが出たときは、Excelシートが立ち上がらず、他のExcelファイルを開いた時に、Book1として立ち上がりますが、これもエラーが出た時でもExcelが立ち上がるようにするには、どのようにしたら良いでしょうか。

MOKさん
こんにちは、平陽凛です。
お訊ねの件ですが、当方では再現しないので
断定はできませんが、選択件数を分割して
実行してみてはいかがでしょうか。
それでもだめなら、セルの文字数制限オーバーかもしれませんので、
  oNewWb.sheets(1).Cells(i, 2).Value = lMsg

  oNewWb.sheets(1).Cells(i, 2).Value = left(lMsg,32767 )
にしてみてはいかがでしょうか。

エラーが発生しても継続してExcelを表示するには、
多少危険かもしれませんが、
  on error resume next
を宣言しておけばよいと思います。

メールの時間だけ抽出したかったのですが、大変役に立ちました!!ありがとうございます!!happy02

avexmaさん、こんばんは。
平陽凛です。
お役に立てて嬉しいです。
今後とも宜しくお願いします。

平陽凛さん、こんばんは。
この「Outlookメール情報をExcel一覧化」の項目の添付ファイルのセルにハイパーリンクを張って、「複数メールの添付ファイルを一括保存」で保存したファイルに繋げる、ということをしたいと考えています。
そこで、メールに複数の添付ファイルがある場合は、添付ファイル名を一つのセルにまとめて入力せず、複数列のセルに一つずつ入力するようにしたいのですが、可能でしょうか?
あるいは、このマクロによりエクセルにいったんコンバートし、エクセル側のマクロでセルの分割処理をした方がスムーズに進みそうでしょうか?
忙しい中申し訳ありませんが、アドバイスいただければ幸いです。

nobuoさん、こんばんわ
平陽凛です。コメントが遅くなってしまい
すみません。
私の感想は以下のとおりです。

>複数列のセルに一つずつ入力するようにしたいのですが、可能でしょうか?
 複数列のセルに分割出力はもちろん可能です。
 その際には複数添付ファイルを想定すると右側のセルに順に連ねていくことになるわけですから、出力情報の一番最後が常に添付ファイルにすることになるでしょう。
 その出力の際に同時にハイパーリンクを設定することも可能ですが、それには以下の条件が必要です。
  (1)Excel一覧化の前に添付ファイルを任意のフォルダに出力されている必要がある
  (2)Excel一覧化マクロは出力先フォルダが事前に分かっているもしくは、実行時にダイアログか何かでフォルダを指定する

>あるいは、このマクロによりエクセルにいったんコンバートし、
>エクセル側のマクロでセルの分割処理をした方がスムーズに進みそうでしょうか?
  上記の条件を考えると、個人的にはこちらの方が汎用的かなと思います。

平陽凛さん、レスありがとうございます。
追加の質問をさせてください・・・。
「複数メールの添付ファイルを一括保存」の際に、「保存先に同じファイル名が存在したら重複しないように枝番を付加するように改良したヴァージョン」を使用した場合、このマクロ(Outlookメール情報をExcel一覧化)から添付ファイルへのハイパーリンクを張るには、こちらのマクロにおいても同じファイル名が存在したら重複しないように枝番を付加する必要があると思うのですが、可能でしょうか?
また、その場合、このマクロで一気にやってしまうことが可能でしょうか、それともいったんエクセルにコンバートしてからエクセルマクロでやったほうがよいでしょうか?

質問ばかりで大変恐縮です・・・。
ヒントだけでもいただけると嬉しいです!

nobuoさん、こんばんわ
平陽凛です。
nobuoさんのやりたいことがなんとなくわかりました。
返信コメントをあれこれ打ち込んでいる内に作れるかなと思い作ってみました。たった今公開しましたのでお試しください。
また、貴重なご意見をください。
それでは。

平野さん、
はじめまして。

メールでの出欠確認の管理のために、タイトルと差出人をExcelに抽出したいと思い検索していたのですが、ビンゴのソースが見つかって助かりました!全く問題なく動作しました。

ところで、OutlookのVBAはどちらで身につけられたのでしょうか?ネットで検索しても、ExcelのVBAのように体系的に説明しているサイトがないので
・・・・。もしオススメの参考書などがあれば、ご紹介頂けますとありがたいです。

るしあさん
こんばんは、平陽凛です。
公開ソースがお役に立てて私も嬉しいです。
私はOutlookはヘルプのサンプルソースを
参考にしたり、ネットで検索したりして作成
しています。あまり本は買いません(笑)。
Excelもそうですがオブジェクトの構成を理解
することが早道だと思います。
ヘルプのキーワードで「オブジェクト」を検索すると、outlookのオブジェクトというのが出てきます。
outlook2000ですが参考までに。

掲載されているサンプルコードをいじりながら、早速ExcelとOutlookのデータ連携を試しています。
こんなことが出来るのか、と感心することしきりです。

大量のメールの外部データへの書き出し以外に、件名に基づいたメールの自動仕訳など、課題がイロイロあるので、こちらの情報をとっかかりに勉強させていただきます。

偶然ですが、本VBAを発見しお世話になっています。利用頻度から考えると必然です。VBAを学習中なので、とても参考になります。VBA□認定を獲得するまでシヌキで応援します !!

いがくせ_xiさん、こんばんは。

当記事が参考になれば幸いです。
VBAエキスパート資格かな?獲得されることを
応援しております。頑張ってくださいね。

コメントを書く

(ウェブ上には掲載しません)

« ♪Piano | トップページ | ▼ダイエット大作戦(近頃だいぶメタボ) »