受信したメールの添付メッセージに含まれる添付ファイルも保存・印刷するマクロ


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


こんにちは。最近マクロの勉強を始めた者です。こちらのマクロを活用させていただき、outlook2007のExchangeサーバーで受信されたメールの添付ファイルの自動保存と自動印刷ができるようになりました。質問ですが、メールの添付ファイルがpdfやexcelの場合はそのまま印刷、メールの添付ファイルがメッセージファイルで、そのメッセージファイルにpdfファイルが添付されてる場合は、メッセージファイルを開いて、pdfファイルの自動保存と自動印刷を行うようにしたいのですが、何か良い方法はありますでしょうか。



添付メッセージにさらにファイルが添付されている場合、そのメッセージをいったん msg ファイルとして保存し、OpenSharedItem メソッドでアイテムとして開きなおすことで、添付ファイルにアクセスができるようになります。
そのため、ご要望は以下のようなマクロで実現できます。

' ここをトリプルクリックでマクロ全体を選択できます。
' 以下はソースの先頭に記載する必要があります。
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                (ByVal hwnd As Long, ByVal lpszOp As String, _
                 ByVal lpszFile As String, ByVal lpszParams As String, _
                 ByVal LpszDir As String, ByVal FsShowCmd As Long) _
                 As Long
'
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim objItem As Object
    Set objItem = Session.GetItemFromID(EntryIDCollection)
    If TypeName(objItem) = "MailItem" Then
        SaveAndPrintAttach objItem
    End If
End Sub
'
Private Sub SaveAndPrintAttach(ByVal objItem As MailItem)
    Const ATTACH_PATH = "c:\attachments\" ' 添付ファイルを保存するフォルダー
    Dim objAttach As Attachment
    Dim strFileName As String
    Dim c As Integer
    Dim objFSO 'As FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    For Each objAttach In objItem.Attachments
        If objAttach.FileName Like "*.xl*" Or objAttach.FileName Like "*.pdf" Then
            ' ファイルが Excel または PDF の場合のみ印刷と保存
            c = 1
            With objAttach
                strFileName = .FileName
                While objFSO.FileExists(ATTACH_PATH & strFileName)
                    strFileName = Left(.FileName, InStrRev(.FileName, ".") - 1) _
                        & "-" & c & Mid(.FileName, InStrRev(.FileName, "."))
                    c = c + 1
                Wend
                .SaveAsFile ATTACH_PATH & strFileName
            End With
            '    保存したファイルを印刷する
            ShellExecute 0, "print", ATTACH_PATH & strFileName, 0, ATTACH_PATH, 0
        ElseIf objAttach.Type = olEmbeddeditem Then
            ' 添付メッセージの場合
            Dim objEmbed As MailItem
            ' msg ファイルとして保存
            objAttach.SaveAsFile ATTACH_PATH & "embedded.msg"
            ' msg ファイルをアイテムとして開きなおす
            Set objEmbed = Session.OpenSharedItem(ATTACH_PATH & "embedded.msg")
            SaveAndPrintAttach objEmbed
        End If
    Next
End Sub

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

広告

受信したメールの添付メッセージに含まれる添付ファイルも保存・印刷するマクロ」への2件のフィードバック

  1. 御礼が遅くなり、申し訳ありません。こちらのマクロで、添付メッセージファイルの中の添付書類まで、一括で印刷できるようになりました。outlookのマクロ、本当に便利で助かりました!どうもありがとうございました。

  2. 初めまして、こんにちは。
    いつもOutlookマクロを勉強させて頂いております。
    早速ですが、ご質問をさせて頂きます。
    こちらの「受信したメールの添付メッセージに含まれる添付ファイルも保存・印刷するマクロ 」を使用し、件名や受信アドレスによって添付ファイルと本文を印刷するように分岐マクロを組み利用させて頂いております。
    利用時の問題がでてきまして、対応が出来ずに困っております。

    ●印刷される条件に当てはまるメールを同時刻に2通以上受信した場合において、すべて印刷条件に当てはまるにも関わらず、1通分しか印刷されません。

    複数受信した場合においても、すべて印刷条件に当てはまる場合はすべて印刷されるようにできますでしょうか。

    お忙しい中、大変恐縮ではありますが、ご回答をお願い申し上げます。

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中