読者です 読者をやめる 読者になる 読者になる

意外となんとかなる日記

世迷言を心に、綺麗事を頭に

スポンサーリンク

【Outlook】検索したい文字列を含む件名のOutlookメールをフォルダに格納するVBA

 指定した文字を件名に含むOutlookメールを抽出し、ファイルとして(.msg形式)でフォルダに保存するVBAプログラムです。
 Excelで作成しましたが、Accessでも使用できると思います。



 Outlookは起動しておいてください。

 このサンプルでは「件名」で"PC"という文字を検索します。プログラム内の"PC"をお好きな文字に置き換えて、使用してください。
 また、"Subject"を"Body"にすれば、本文検索も可能です。

Sub GetMailToFile()
    ' Outlookのメールで条件に一致するメールをファイル保存する
    Dim ol As Object
    Dim fileName As String
    Const CON_OUTFOLDER = "C:\OUTMAIL\"     ' 出力先フォルダ(事前に作成しておく)
    
    ' 起動しているOutlookを取得
    Set ol = GetObject(, "Outlook.Application")
    If ol Is Nothing Then Exit Sub
    
    ' メール一覧取得
    For Each itms In ol.GetNamespace("MAPI").GetDefaultFolder(6).Items  ' olFolderInbox:6
        If itms.Class = 43 Then ' olMail:43
            If InStr(itms.Subject, "PC") > 0 Then                       ' Subject:件名、Body:本文
                ' ファイル名として使用できない文字を置換
                fileName = itms.Subject
                fileName = Replace(fileName, "\", "")
                fileName = Replace(fileName, "/", "")
                fileName = Replace(fileName, ":", "")
                fileName = Replace(fileName, "*", "")
                fileName = Replace(fileName, "?", "")
                fileName = Replace(fileName, "<", "")
                fileName = Replace(fileName, ">", "")
                fileName = Replace(fileName, "|", "")
                
                ' メールを保存
                itms.SaveAs CON_OUTFOLDER & fileName & ".msg", 3        ' olMSG:3
            End If
        End If
    Next
    
    Set ol = Nothing
    
    ' フォルダを表示
    CreateObject("Shell.Application").Open CON_OUTFOLDER
End Sub


 こんな感じになります。

 f:id:Suechan:20161206211504j:plain


 動作確認はExcel2016で行いましたが、2010や2013でも動作するはずです。

 ファイル形式についてはこちらにあります。
 OlSaveAsType 列挙体 (Microsoft.Office.Interop.Outlook)



suechan.hateblo.jp

スポンサーリンク