特定のキーワードを含むメールを受信したら添付 Excel ファイルを印刷してフォルダーに移動するマクロ


受信した Excel ファイルを印刷するマクロのコメントにて以下のご要望をいただきました。


件名に特定の”依頼票””予約”が入っていてかつ、添付ファイルがEXCELの場合のみ添付ファイルを自動的に印刷して、”印刷済”フォルダへ移動するマクロを教えてご教示願えませんでしょうか?
よろしくお願い致します。


もともとのマクロはルールから呼び出すことを想定していましたが、「依頼票」と「予約」という二つのキーワードを含むというルールは作成ができないため、受信時に発生する NewMailEx イベントで条件をチェックし、条件に合致する場合に印刷するマクロを呼び出す必要があります。
以下のようなマクロで実現できます。

' ここをトリプルクリックでマクロ全体を選択できます。
' 以下はソースの先頭に記載する必要があります。
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" And objItem.Subject Like "*依頼票*予約*" Then
         Dim objMail As MailItem
         Dim fldInbox As Folder
         Dim fldPrinted As Folder
         ' メールアイテムに変換
         Set objMail = objItem
         ' Excel の添付ファイルを印刷
         PrintExcelAttach objMail
         ' 受信トレイを取得
         Set fldInbox = Session.GetDefaultFolder(olFolderInbox)
         ' 受信トレイの下の「印刷済」フォルダーを取得
         Set fldPrinted = fldInbox.Folders("印刷済")
         ' 受信トレイと同じ階層の「印刷済」フォルダーの場合は以下の記述を使用
         'Set fldPrinted = fldInbox.Parent.Folders("印刷済")
         ' 「印刷済」フォルダーにメールを移動
         objMail.Move fldPrinted
     End If
End Sub
'
Public Sub PrintExcelAttach(ByRef objItem As MailItem)
     On Error Resume Next
     Const ATTACH_PATH = "c:\temp\" ' 添付ファイルを保存するフォルダー
     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 "*.xls*" Then
             ' ファイルが Excel の場合のみ保存して印刷
             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
         End If
     Next
End Sub

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

特定のキーワードを含むメールを受信したら添付 Excel ファイルを印刷してフォルダーに移動するマクロ」への2件のフィードバック

  1. マクロの作成 大変感謝致します。他の質問の構文を自分なりに分析してトライアンドエラーは空き時間にしていたのですが、、、、 ここれに追加で 添付ファイルの範囲 C$2:$W$48 のみを印刷と追記は可能でしょうか?

    • このマクロでは ShellExecute により印刷を行っていますが、保存した Excel ファイルを Excel で開けば範囲選択の印刷も可能なのではないかと思います。

コメントを残す

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

WordPress.com ロゴ

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

Google フォト

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

Twitter 画像

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

Facebook の写真

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

%s と連携中