メッセージを受信したら自動返信し、メール本文と添付ファイルを印刷するマクロ IMAP4 対応版


以前、メッセージを受信したら自動返信し、メール本文と添付ファイルを印刷するマクロを作成したのですが、IMAP4 アカウントではこのマクロが正しく動作しないことが確認できました。

これは、Outlook 2010 までの IMAP4 アクセスが常に以下のような 2 段階で行われるためです。

  1. メールがサーバーに着信した際のヘッダーのみのダウンロード
  2. 送受信間隔、またはメールを開いた場合に発生するメール全体のダウンロード

この動作は [添付ファイルを含む完全なアイテムをダウンロード] が選択されている場合でも変わらず、常にヘッダーのみが受信され、その後メール全体という流れになります。

問題は、マクロの NewMailEx イベントは上記の 1. のタイミングで発生するということです。
このタイミングではヘッダーだけがダウンロードされている状態であるため、マクロからは件名や差出人などの情報は取得できても、本文や添付ファイルが取得できません。

そこで、上記の 2. のタイミングで動作するようなマクロを作ってみました。
Outlook オブジェクト モデルには、送受信を実行するためのオブジェクトとして SyncObject があり、このオブジェクトの SyncEnd イベントが送受信の終了のタイミングで発生するため、このイベントで新着メールに対する処理を記載することにより、IMAP4 でも受信したメールの本文や添付ファイルに対してアクセスができるようになります。
マクロのサンプルは以下の通りです。

' ここをトリプルクリックでマクロ全体を選択できます。
' 以下はソースの先頭に記載する必要があります。
' 送受信のオブジェクト
Private WithEvents mySync As SyncObject
' 新着メールのエントリー ID を保存する変数
Private g_strEIDs As String
' 新着メールのイベント
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    ' エントリー ID を保存して送受信実行
    g_strEIDs = g_strEIDs & EntryIDCollection & ";"
    Set mySync = Session.SyncObjects.Item(1)
    mySync.Start
End Sub
' 送受信完了時に実行されるイベント
Private Sub mySync_SyncEnd()
    Dim astrEids() As String
    Dim strEid As String
    Dim objItem As MailItem
    Dim i As Integer
    astrEids = Split(g_strEIDs, ";")
    g_strEIDs = ""
    For i = 0 To UBound(astrEids)
        strEid = astrEids(i)
        If strEid <> "" Then
            Set objItem = Session.GetItemFromID(strEid)
            ' 受信メッセージに対して行う処理を呼び出す
            ReplyAndPrintMessage objItem
        End If
    Next
End Sub
'
Private Sub ReplyAndPrintMessage(ByVal objItem As MailItem)
    Const CC_ADDRESS = "cc@example.com" ' cc で追加する受信者のアドレス
    Const ATTACH_PATH = "c:\attachments" ' 添付ファイルを保存するフォルダー
    Dim iSeqNum As Integer
    Dim objReply As MailItem
    Dim objRec As Recipient
    Dim objAttach As Attachment
    Dim strFileName As String
    ' 1. メールの表題に管理番号をつける。
    '    管理番号取得
    iSeqNum = CInt(GetSetting("OutlookLab", "ReplyAndPrintMessage", "SeqNumber", 1))
    '    件名に管理番号を付与
    objItem.Subject = "[管理番号:" & iSeqNum & "]" & objItem
    ' 2. そのメールに対して自動返信する。
    Set objReply = objItem.ReplyAll
    '    返信メッセージの本文設定
    objReply.Body = "メールを受け付けました。" & vbCrLf & objReply.Body
    ' 3. 自動返信にはccに所定の社内メンバーを入れる
    Set objRec = objReply.Recipients.Add(CC_ADDRESS)
    objRec.Type = olCC
    objRec.Resolve
    '    返信メールを送信。
    objReply.Send
    ' 4. 受信メール内のメッセージを印刷する。
    objItem.PrintOut
    ' 添付ファイルがある場合の処理
    If objItem.Attachments.Count > 0 Then
        ' 5. 添付されている PDF ファイルをメールの表題と同じ管理番号をつけ、所定の場所に保存し、印刷する。
        '    添付ファイルを取得
        Set objAttach = objItem.Attachments.Item(1)
        '    所定の場所に管理番号を付けて保存
        strFileName = ATTACH_PATH & "\管理番号 " & iSeqNum & "-" & objAttach.FileName
        objAttach.SaveAsFile strFileName
        '    保存したファイルを印刷する
        ShellExecute 0, "print", strFileName, 0, ATTACH_PATH, 0
    End If
    ' 管理番号を更新
    iSeqNum = iSeqNum + 1
    SaveSetting "OutlookLab", "ReplyAndPrintMessage", "SeqNumber", iSeqNum
End Sub

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

広告

メッセージを受信したら自動返信し、メール本文と添付ファイルを印刷するマクロ IMAP4 対応版」への2件のフィードバック

  1. こちらのサンプル大変参考にさせいていただいております。ひとつお聞きしたいことがありますが、PDFファイルを印刷する際にパスワードがかかっているPDFもパスワードを解除し、印刷することは出来ないでしょうか。よろしくお願い致します。

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中