添付ファイルから特定の宛先に対してメールを作成するExcelVBA

スポンサーリンク

Excelでの申請書・申込書などの集計に便利なツールの紹介

Excelのファイルに内容を記載してメールに添付して送るという一連の流れは日常の業務でかなり多くの方が行うことだと思います。
私の勤務している部署でも営業所から本社あてに申請書・申込書などがたくさん送られてきます。

メールにファイルを添付して申請や申込みを受け付けるのはハードやソフトの面でコストがかかりにくく、導入のハードルが低いのは大きなメリットですが、代わりにどこにどのような形式でいつ送るかというのを明確に定めていないとメールを受ける方が大変になってしまいます。

意図している宛先とは異なるところにメールを送られてしまったり、集計するのに必要な項目に不備があったり、きちんと受付されているか確認のメールがさらに届いたり、効率を下げてしまう色々な要因があります。

今回はExcelファイルの申請書・申込書を作成するにあたり、メールを起動するボタンを用意することで送信先を間違えるリスクを減らし、メール作成の時間を短縮するExcelVBAを考えてみましたのでご紹介します。

申込書に組み込むExcelVBAコード

必要事項を記入後、すぐにOutlookを起動してメールを作成し、記入した申込書を添付するExcelVBAコードを考えてみました。

読み取り専用で開いていた場合は名前を付けて保存、読み取り専用でなければ上書き保存を行い、そのファイルをメールに添付します。

またメールに添付する際、ファイル名にアカウント名やファイル作成日時を追加するためにマイドキュメントにフォルダを作成し、ファイル名を変更したものを保存してから添付するというステップをはさんでいます。
(エラーを起こさずに進めば、マイドキュメントのファイルは削除されます。)

下記のマクロを実行しやすくするために、私はワークシート上に「メール作成」と記載したボタンを用意して活用しています。

Sub メール作成ファイル添付()

Dim oApp As New Outlook.Application
Dim oItem As Outlook.MailItem
Dim 本文

Dim WSH As Object
Set WSH = CreateObject(“Wscript.Shell”)
Dim FSO As Object
Set FSO = CreateObject(“Scripting.FileSystemObject”)
Dim DesktopPath As String
DesktopPath = WSH.SpecialFolders(“Desktop”)
Dim DocumentPath As String
DocumentPath = WSH.SpecialFolders(“MyDocuments”)

Dim 日付
Dim 時間
Dim 日時
Dim rc

’添付ファイル名に日付と時間を追加するための準備
日付 = Date
時間 = Time
日時 = Year(日付) & Format(Month(日付), “00”) & Format(Day(日付), “00”) & _
“_” & Format(Hour(時間), “00”) & Format(Minute(時間), “00”) & Format(Second(時間), “00”)

Set oItem = oApp.CreateItem(olMailItem)

Dim 保存ファイル名
保存ファイル名 = DocumentPath & “メール添付用_” & 日時 & “” & oItem.Session.CurrentUser & “_” & Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, “.”) - 1) & “_” & 日時 & “.xlsm”

’読み取り専用でなければ上書き保存して閉じる
If ActiveWorkbook.ReadOnly = False Then
rc = MsgBox(“ファイルを閉じて、メールに添付しますか?” & vbCrLf & “ファイルは上書き保存されます。”, vbOKCancel)
If rc = vbCancel Then
MsgBox “キャンセルしました。”
Exit Sub
End If

ActiveWorkbook.Save

’読み取り専用なら保存先とファイル名を指定して保存してから次のステップに進む
Else
rc = MsgBox(“ファイルを閉じて、メールに添付しますか?” & vbCrLf & “添付する場合はファイルの保存先を選択してください。”, vbOKCancel)
If rc = vbCancel Then
MsgBox “キャンセルしました。”
Exit Sub
End If

FName = Application.GetSaveAsFilename(InitialFileName:=Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, “.”) - 1) & “_” & 日時 & “.xlsm”, FileFilter:=”Excelマクロ有効ブック,*.xlsm”)
If FName <> “False” Then
ActiveWorkbook.SaveAs Filename:=FName
Else
MsgBox “ファイル名を指定して保存してください。”
Exit Sub
End If
End If

’マイドキュメントの中に存在しない(と思われる)フォルダ「メール添付用_日時」を作成する
If FSO.FolderExists(DocumentPath & “メール添付用_” & 日時) = False Then
FSO.CreateFolder DocumentPath & “メール添付用_” & 日時
End If

’保存した添付ファイルをマイドキュメント下の「メール添付用_日時」の中にコピーする
FSO.CopyFile ThisWorkbook.FullName, 保存ファイル名

oItem.To = “宛先を記入”
oItem.Subject = oItem.Session.CurrentUser & “_” & Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, “.”) - 1) & “_” & “タイトルを記入”

本文 = “添付を確認の上送信してください。”
oItem.HTMLBody = “” & 本文 & “
oItem.Attachments.Add 保存ファイル名 ’マイドキュメント下の「メール添付用_日時」の中にコピーしたファイルを添付する

oItem.Display ’送信せずに画面を表示する

FSO.DeleteFolder DocumentPath & “メール添付用_” & 日時
Set oItem = Nothing

Application.Quit

End Sub

Outlookの操作が必要なので、「Outlook ×× Object Library」の参照設定をオンにしてください。
参照設定の手順についてはこちらの記事を参考にしてください。

宛先を都度変更して使いたい場合、非表示のシートを用意して、そのシート内に宛先を記入しておく方法もあります。
VBAコードを編集しなくても宛先を変更できるようになるので、色々な人が使用することを前提に作成する場合におすすめです。

スポンサーリンク

Outlookで差し込み印刷のようにたくさんのメールを作成するExcelVBAと対になる機能

以前こちらの記事で差し込み印刷のようにたくさんのメールを作成するExcelVBAコードを紹介しましたが、たくさんのメールを一括で作成する機能は「本社→多数の営業所」に一括でメールを送るのを助けるツールです。

それに対して、今回ご紹介した申請書・申込書の補助ツールは「多数の営業所→本社」に情報を送る際に使用するツールとなります。

営業所側はメールを作成する時間を短縮できて、かつ正確に相手に送信できるのが大きなメリットです。

一方、本社(メールの受け取り側)は決まったフォーマットのファイルが添付されたメールが正しい宛先に指定した件名で届くので集計に役立ちます。
このツールは送り側と受け取り側のいずれにもメリットがあります。

コメント