コード
Sub メールにファイルを一括添付する() Dim objOutlook As Object Dim objNamespace As Object Dim objFolder As Object Dim objMailItem As Object Dim objAttachment As Object Dim strFolderPath As String Dim strPDFPath As String Dim strFileName As String ' Outlookを起動 Set objOutlook = CreateObject("Outlook.Application") Set objNamespace = objOutlook.GetNamespace("MAPI") ' フォルダのパスを指定 strFolderPath = ThisWorkbook.Path strPDFPath = Range("B1") & "\" & Range("B2") ' フォルダ内のすべてのファイルに対して処理 strFileName = Dir(strFolderPath & "\*.msg") Do While strFileName <> "" ' メールアイテムを作成 Set objMailItem = objOutlook.CreateItemFromTemplate(strFolderPath & "\" & strFileName) ' PDFファイルを添付 Set objAttachment = objMailItem.Attachments.Add(strPDFPath) ' メールを送信 objMailItem.Send ' 次のファイルへ移動 strFileName = Dir Loop ' リソースを解放 Set objAttachment = Nothing Set objMailItem = Nothing Set objFolder = Nothing Set objNamespace = Nothing Set objOutlook = Nothing MsgBox "添付完了" End Sub
下準備
添付したいファイルのフォルダパスとファイル名をマクロが入ってるエクセルに入力する。
B1に添付ファイルのフォルダパス、B2に添付ファイルのファイル名(拡張子込み)を入力。
※拡張子まで入力しないと作動しないため注意!
添付したいメールをマクロエクセルと同じフォルダにコピーする。
※アウトルック側に添付する前のメールが残っている場合は紛らわしいので削除しておくとよい。
ここまで準備したらマクロ実行
結果
全てのメールに添付された。
※添付後直ちに送信されるマクロなので、下記の画像のように送信トレイで確認したい場合はアウトルック側で送受信をオフにする設定をすること。
ちゃんと添付されてる。
注意点
ファイルが添付されたメールは新しく送信されるため、添付する前のメールがアウトルックに残っていると紛らわしいことになる。
赤枠内が添付後のメール、黄色枠内が添付前のメール
間違えて二重に送ってしまうことを防止するため、メールをフォルダにコピーした時点で、アウトルックのメールは消しておくとよい。