特定のフォルダーにあるメールに更新した Excel ファイルを添付して返信するマクロ


コメントにて以下のご要望をいただきました。


とても素晴らしいサイトにたどりつきコメントさせていただきます。
お力をお貸しいただきたいです。

▼使用環境
OS:Windows 10 Pro Ver.1803 ビルド.17134.471
  Outlook2016 16.0.9126.2259

▼参考にした過去記事
Excel のリストにしたがってファイルを添付して送信するマクロ

▼やりたいこと
1)グループメールに届くメールを個人メールフォルダ(A)にコピーし、添付ファイルを取り出す。おおよそ30通ほどあります。
   届くメールはタイトルにそれぞれ数字の羅列があります。
   添付ファイルは「0005-0200」形式の名前+.csv/.xls/.pdf の3ファイルである。(B)
  名前は数字部分が都度変わります。規則性はなし。タイトルとの関連性もなし。

  こちらはエクセルVBA(C)にてファイルの取り出し済み。以下の形式でエクセル(C)にリスト出力されています。
   A列:番号(連番のメール番号)
   B列:受信日時
   C列:タイトル
   D列:送信元アドレス
   E列:添付ファイル数
   F列:エクセルファイル名

2).csv/.pdfファイルは不要なので削除し、エクセルファイル(B)に加工を加え(加工後のもの=B’)、上書き保存する。

3)個人メールフォルダ(A)のメールに1通ずつ返信する。(一括でやりたい)
  本文に定型文書を添付。
   CCにメールアドレスを追加したい。
   元メールに添付されていたものと同じファイル(B)の加工済みファイル(B’)を添付して送信したい。

▼状況
1)、2)までは運用できている状態です。
3)からができずに困っています。

▼困っていること
  メール1通に対して返信というのは他のVBAを参照してできるかと思いますが、該当ファイルを添付する、更にはこのフォルダ(A)に入っているメールすべてに適用する場合はどのようにしたらよいかわかりません。
  希望としては先にリスト化しているエクセル(C)のタイトルと添付ファイル名の情報をもとに対応する添付ファイルを添付する方法が望ましいと思いますがそもそもOUTLOOK VBAの範疇なのでしょうか。もしくはOUTLOOK VBAで1通ずつならばエクセル(C)の情報は使わずに自動で本文に定型文を追加し、該当ファイル(B’)を添付し送信できるものなのでしょうか。

お力おかしいただきたく、お願い申し上げます。


特定のフォルダーに格納されているすべてのアイテムに対して処理を行うには、For Each を使って指定したフォルダーの Items に含まれるアイテムを処理するループを記述します。

そして、返信メールに加工済みのファイルを添付するということですが、加工済みファイルは上書き保存しているということなので、ファイル名は元のメールの添付ファイルのファイル名と同じと考えられます。
したがって、Excel ファイルを使わなくても、以下のような流れで返信メールを作成することは可能でしょう。

  1. フォルダーのメールの添付ファイルのファイル名をチェック
  2. ファイルが Excel ファイルであれば、そのファイル名を保存して返信メールを作成
  3. 加工済みの Excel ファイルが格納されているフォルダーから同じファイル名のファイルを返信メールに追加

以下の前提条件で動作するマクロを作成しました。

  • 処理をするメールは受信トレイの下に作成したサブ フォルダーに格納されている
  • 返信メールの本文を記載したメールがマクロの OFT_FILE で定義したファイル名であらかじめ作成されている
  • 添付ファイル名が複数のメールで重複することはない

マクロは以下のようになります。

' ここをトリプルクリックでマクロ全体を選択できます。

Public Sub ReplyWithAttachmentInFolder()
     ' メールが格納されているフォルダー (受信トレイのサブ フォルダー)
     Const FOLDER_NAME = "Test"
     ' 返信メールの本文を設定した OFT ファイル
     Const OFT_FILE = "c:\temp\reply.oft"
     ' CC に追加するアドレス
     Const CC_ADDRESS = "cc@example.com"
     ' 変更後の添付ファイルが格納されているフォルダー
     Const ATTACH_FOLDER = "c:\temp\" ' 最後に \ をつける
     '
     Dim fldInbox As Folder
     Dim fldCurrent As Folder
     Dim itmTemp As MailItem
     Dim itmOrig As MailItem
     Dim attFile As Attachment
     Dim strFileName As String
     Dim itmReply As MailItem
     Dim ccRecip As Recipient
     ' メールが格納されているフォルダーを取得
     Set fldInbox = Session.GetDefaultFolder(olFolderInbox)
     Set fldCurrent = fldInbox.Folders(FOLDER_NAME)
     ' テンプレートからメールを作成
     Set itmTemp = CreateItemFromTemplate(OFT_FILE)
     ' フォルダー内のすべてのメールを処理
     For Each itmOrig In fldCurrent.Items
         strFileName = ""
         ' アイテムの添付ファイルをチェック
         For Each attFile In itmOrig.Attachments
             If attFile.FileName Like "*.xls*" Then
                 ' Excel ファイルだったらファイル名を取得
                 strFileName = attFile.FileName
             End If
         Next
         ' Excel ファイルが見つかったら返信処理
         If strFileName <> "" Then
             ' 全員に返信
             Set itmReply = itmOrig.ReplyAll
             ' CC にアドレスを追加
             Set ccRecip = itmReply.Recipients.Add(CC_ADDRESS)
             ccRecip.Type = olCC
             ' テンプレートの本文を返信メールに設定
             If itmReply.BodyFormat = olFormatHTML Then
                 itmReply.HTMLBody = itmTemp.HTMLBody
             Else
                 itmReply.Body = itmTemp.Body
             End If
             ' 更新された Excel ファイルを添付
             itmReply.Attachments.Add ATTACH_FOLDER & strFileName
             ' メールを送信
             itmReply.Send
         End If
     Next
     '
     itmTemp.Delete
End Sub

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

広告

コメントを残す

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

WordPress.com ロゴ

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

Google フォト

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

Twitter 画像

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

Facebook の写真

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

%s と連携中