受信したメールを自動的に MSG ファイルとして保存するマクロ


受信したメールの添付ファイルを自動保存するマクロのコメントにて以下のご要望をいただきました。


お世話になります。

いつも参考にさせていただいています。

受信をトリガーとし、メール自体を.msgファイルとして保存する場合はどのようになるのでしょうか?


メール自体を保存する場合は、MailItem オブジェクトの SaveAs メソッドを使用します。
件名をファイル名にする場合、件名には \ や :、* などファイル名に使用できない文字が含まれる場合があるため、それを別の文字に置き換える必要があります。
以下のマクロでは受信時のイベントで SaveAsMsg というプロシージャを呼び出し、その中で条件判定をするようにしていますが、条件判定のための記述がよくわからないというようであれば、SaveAsMsg だけをマクロとして定義し、自動仕分けのルールのスクリプトとして SaveAsMsg を呼び出すようにすれば、条件判定をルールの設定でできるようになります。

' ここをトリプルクリックでマクロ全体を選択できます。
' メール受信時に発生するイベント
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
     On Error Resume Next
     Dim objItem As Object
     Dim objMsg As MailItem
     ' 受信アイテムを取得
     Set objItem = Session.GetItemFromID(EntryIDCollection)
     ' アイテムがメールだったら保存処理
     If TypeName(objItem) = "MailItem" Then
         Set objMsg = objItem
         SaveAsMsg objMsg
     End If
End Sub
  '
  ' MSG ファイルとして保存するサブ プロシージャ
Public Sub SaveAsMsg(ByRef objMsg As MailItem)
     ' ファイルを保存するフォルダーを指定。最後に \ が必要
     Const SAVE_PATH = "C:\temp\"
     Dim objFSO As Object ' FileSystemObject
     Dim strSubject As String
     Dim strFileBase As String
     Dim strFileName As String
     Dim i As Integer
     Dim ch As String
     Dim c As Integer
     '
     Set objFSO = CreateObject("Scripting.FileSystemObject")
'
' ここで条件指定
' 例えば、test という文字列を件名に含むものだけ保存する場合、
' 「test を件名に含まない場合に Exit Sub」というコードにする
'
'  If Not (objMsg.Subject Like "*test*") Then Exit Sub
'
     ' 件名をファイル名にする
     strSubject = objMsg.Subject
     ' 件名の前に受信日時をつける場合は以下を使用
     ' strSubject = objMsg.ReceivedTime & " " & objMsg.Subject
     ' 件名の前に差出人をつける場合は以下を使用
     ' strSubject = objMsg.SenderName & " " & objMsg.Subject
     ' ファイル名に使用できない文字を _ に置き換える
     strFileBase = ""
     For i = 1 To Len(strSubject)
         ch = Mid(strSubject, i, 1)
         If InStr("\/:*?""<>|", ch) > 0 Then
             ch = "_"
         End If
         strFileBase = strFileBase & ch
     Next
     '
     strFileName = SAVE_PATH & strFileBase & ".msg"
     '
     c = 1
     ' 同名のファイルが存在したら
     While objFSO.FileExists(strFileName)
         ' ファイル名に -連番 をつける
         strFileName = SAVE_PATH & strSubject & "-" & c & ".msg"
         c = c + 1
     Wend
     ' MSG ファイルとして保存する
     objMsg.SaveAs strFileName, olMSG
     Set objFSO = Nothing
End Sub

マクロの登録方法やメニューへの追加について

広告

受信したメールを自動的に MSG ファイルとして保存するマクロ」への1件のフィードバック

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト /  変更 )

Google+ フォト

Google+ アカウントを使ってコメントしています。 ログアウト /  変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト /  変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト /  変更 )

%s と連携中