Create Outlook Text Mail by Excel VBA
はじめに
エクセルシートにメールの定型の内容を記入しておき、ボタンを押すとOutlookのメールの画面を起動してくれるマクロを考えました。
・動作は無保証です。
・エクセルで動くマクロです。
・動作確認は、Windows 10 + Excel 2016、Windows 7 + Excel 2010でおこなっています。
・参照設定は、「Microsoft Outlook 16.0 Object Library」に対して参照設定してください（Excel 2016の場合）。
・ExcelとOutlookのバージョンがそろっていない場合（例えば、Excel 2016 と Outlook 2010 など）、本マクロは動かない可能性が高いと思います。参照設定をうまく設定すれば動くかもしれませんが、バージョンをそろえることをおススメします。
・ファイルはここからダウンロードしてください。
VBAでOutlookテキストメールを作成するマクロのソース
Option Explicit
'「ツール(T)」⇒「参照設定(R)...」から以下のライブラリにチェックを
'入れてください。
'「Microsoft Outlook 16.0 Object Library」（バージョンの数字は可変）
Public Sub S_AttachPDFFile()
'PDFファイル名を取得
'ButtonNameは実際にファイルを指定すると変化する。
'複数ファイルを添付したいときは、AllowMultiSelect = trueにする。
'InitialFileNameは最後にフォルダを指定することを表す「\」マークを
'付けるとダイアログのファイル名欄が空白になる。
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "送信するPDFファイルを添付してください"
.ButtonName = "PDF添付(&A)"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
'.InitialFileName = "C:\Users\amacoda\Documents\PDF ファイル\"
'フィルタでファイルの種類を「PDFファイル」に絞り込む。
'他のファイルを選択したい場合、それに応じたフィルタを設定する。
With .Filters
.Clear
.Add "PDFファイル", "*.pdf"
End With
'キャンセルが押されたらプログラムを終了
'キャンセルを押すと、Microsoftの解説によれば、「0」を返す。
'しかし、「OK」の時は「-1」を返すのだから、この場合は「False」を
'使っても特に問題はない。
If .Show = False Then Exit Sub
'選択したファイルのフルパスをセル「C12」に代入
'セルに直にファイルのフルパスの文字列を代入するのではなく、一度
'数に代入して代入するものがファイルのフルパスであることを明示
'している。
Dim FilePath As String
FilePath = .SelectedItems(1)
Range("C12").Value = FilePath
End With
End Sub
Public Sub S_CreateOutlookTextMail()
'PDFファイルが添付されていなければプログラムを終了
Select Case Range("C12").Value
'添付ファイル名の欄が空白の場合
Case ""
MsgBox "PDFファイルが添付されていません。" & vbCrLf & _
"送信するPDFファイルを添付してください。", _
vbOKOnly + vbExclamation, "メール送信管理"
Exit Sub
'添付ファイル名の拡張子が「.pdf」でない場合
Case Else
Dim Extension As String
Extension = LCase(Right(Range("C12").Value, 4))
If Extension <> ".pdf" Then
MsgBox "PDFファイルが添付されていません。" & vbCrLf & _
"ファイルの拡張子をよく確認して" & vbCrLf & _
"PDFファイルを添付してください。", _
vbOKOnly + vbExclamation, _
"メール送信管理"
Range("C12").Value = ""
Exit Sub
End If
End Select
'宛先が入力されていなければプログラムを終了
Dim toAddress As String
toAddress = Range("C3").Value
Dim ccAddress As String
ccAddress = Range("C4").Value
Dim bccAddress As String
bccAddress = Range("C5").Value
If toAddress = "" And ccAddress = "" And bccAddress = "" Then
MsgBox "宛先を入力してください。", vbOKOnly + vbExclamation, _
"メール送信管理"
Exit Sub
End If
'Outlook起動中であればそのままOutlookオブジェクトを取得
'Outlook未起動であればOutlookを起動 -> Outlookオブジェクトを取得
'Outlook未起動の状態でオブジェクトを取得すると、Outlookは非表示
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")
With olApp
'Outlookが非表示であれば、ActiveWindowメソッドはNothingを返す。
'Outlookが非表示であれば、送信済みアイテムフォルダを開く。
If .ActiveWindow Is Nothing Then
'Outlookの主要なオブジェクトであるNameSpaceオブジェクトを取得
Dim myNameSpace As Outlook.Namespace
Set myNameSpace = .GetNamespace("MAPI")
'送信済みアイテムフォルダを取得
'これからメールを送信するので、先に送信済みアイテムフォルダを
'開いておく。
Dim myFolder As Outlook.Folder
Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
'送信済みアイテムフォルダを表示
myFolder.Display
'Outlookは、最初に開いた画面サイズを最大だと勘違いして記憶して
'いるので、一度標準サイズに変更してから画面を最大化する。
'送信済みアイテムの画面を最大化する。
With .ActiveWindow
.WindowState = olNormalWindow
.WindowState = olMaximized
End With
End If
End With
'送信メールのオブジェクトを取得
Dim myMailItem As Outlook.MailItem
Set myMailItem = olApp.CreateItem(olMailItem)
'添付ファイルのコレクションを取得
Dim myAttachments As Outlook.Attachments
Set myAttachments = myMailItem.Attachments
'添付ファイルコレクションにPDFファイルを追加
Dim AttachedFile As String
AttachedFile = Range("C12").Value
'Outlook 2003以前であれば、リッチテキストメール(olFormatRichText)
'作成時に
'.BodyFormat = olFormatRichText
'として、AddメソッドでPosition:=～（～はLong型変数）とすることで、
'添付ファイルの挿入位置を指定できたが、
'Outlook 2010以降では、その指定は無効になっている。
'つまり、リッチテキスト形式のメールは推奨されず、
'使わないほうがいいという形式になっている。
myAttachments.Add Source:=AttachedFile
'送信メールの内容作成
With myMailItem
'メールの表示形式はテキスト形式にする
.BodyFormat = olFormatPlain
'送信先を指定（To・CC・BCC）
.To = toAddress
.CC = ccAddress
.BCC = bccAddress
'件名を作成（件名１・件名２を合成）
Dim Subject1 As String
Subject1 = Range("C6").Value
Dim Subject2 As String
Subject2 = "(" & Format(Range("C7").Value, "m/d") & ")"
Dim Subject As String
Subject = Subject1 & Subject2
.Subject = Subject
'本文を作成（本文１・日付・本文２を合成）
Dim MailBody1 As String
MailBody1 = Replace(Range("C8").Value, vbLf, vbCrLf)
Dim MailBodyDate As String
MailBodyDate = Format(Range("C9").Value, "m/d")
Dim MailBody2 As String
MailBody2 = Replace(Range("C10").Value, vbLf, vbCrLf)
Dim MailBody As String
MailBody = MailBody1 & MailBodyDate & MailBody2
'署名を指定
Dim Signature As String
Signature = Replace(Range("C11").Value, vbLf, vbCrLf)
'本文と署名を合成
.Body = MailBody & vbCrLf & vbCrLf & Signature & vbCrLf & vbCrLf
'送信メールを表示
.Display
End With
'オブジェクトの解放
Set myAttachments = Nothing
Set myMailItem = Nothing
Set myFolder = Nothing
Set myNameSpace = Nothing
Set olApp = Nothing
End Sub- Option Explicit
- '「ツール(T)」⇒「参照設定(R)...」から以下のライブラリにチェックを
- '入れてください。
- '「Microsoft Outlook 16.0 Object Library」（バージョンの数字は可変）
- Public Sub S_AttachPDFFile()
- 'PDFファイル名を取得
- 'ButtonNameは実際にファイルを指定すると変化する。
- '複数ファイルを添付したいときは、AllowMultiSelect = trueにする。
- 'InitialFileNameは最後にフォルダを指定することを表す「\」マークを
- '付けるとダイアログのファイル名欄が空白になる。
- With Application.FileDialog(msoFileDialogFilePicker)
- .Title = "送信するPDFファイルを添付してください"
- .ButtonName = "PDF添付(&A)"
- .AllowMultiSelect = False
- .InitialView = msoFileDialogViewList
- '.InitialFileName = "C:\Users\amacoda\Documents\PDF ファイル\"
-
- 'フィルタでファイルの種類を「PDFファイル」に絞り込む。
- '他のファイルを選択したい場合、それに応じたフィルタを設定する。
- With .Filters
- .Clear
- .Add "PDFファイル", "*.pdf"
- End With
-
- 'キャンセルが押されたらプログラムを終了
- 'キャンセルを押すと、Microsoftの解説によれば、「0」を返す。
- 'しかし、「OK」の時は「-1」を返すのだから、この場合は「False」を
- '使っても特に問題はない。
- If .Show = False Then Exit Sub
-
- '選択したファイルのフルパスをセル「C12」に代入
- 'セルに直にファイルのフルパスの文字列を代入するのではなく、一度
- '数に代入して代入するものがファイルのフルパスであることを明示
- 'している。
- Dim FilePath As String
- FilePath = .SelectedItems(1)
- Range("C12").Value = FilePath
- End With
- End Sub
- Public Sub S_CreateOutlookTextMail()
- 'PDFファイルが添付されていなければプログラムを終了
- Select Case Range("C12").Value
- '添付ファイル名の欄が空白の場合
- Case ""
- MsgBox "PDFファイルが添付されていません。" & vbCrLf & _
- "送信するPDFファイルを添付してください。", _
- vbOKOnly + vbExclamation, "メール送信管理"
- Exit Sub
- '添付ファイル名の拡張子が「.pdf」でない場合
- Case Else
- Dim Extension As String
- Extension = LCase(Right(Range("C12").Value, 4))
- If Extension <> ".pdf" Then
- MsgBox "PDFファイルが添付されていません。" & vbCrLf & _
- "ファイルの拡張子をよく確認して" & vbCrLf & _
- "PDFファイルを添付してください。", _
- vbOKOnly + vbExclamation, _
- "メール送信管理"
- Range("C12").Value = ""
- Exit Sub
- End If
- End Select
-
- '宛先が入力されていなければプログラムを終了
- Dim toAddress As String
- toAddress = Range("C3").Value
-
- Dim ccAddress As String
- ccAddress = Range("C4").Value
-
- Dim bccAddress As String
- bccAddress = Range("C5").Value
- If toAddress = "" And ccAddress = "" And bccAddress = "" Then
- MsgBox "宛先を入力してください。", vbOKOnly + vbExclamation, _
- "メール送信管理"
- Exit Sub
- End If
-
- 'Outlook起動中であればそのままOutlookオブジェクトを取得
- 'Outlook未起動であればOutlookを起動 -> Outlookオブジェクトを取得
- 'Outlook未起動の状態でオブジェクトを取得すると、Outlookは非表示
- Dim olApp As Outlook.Application
- Set olApp = CreateObject("Outlook.Application")
-
- With olApp
- 'Outlookが非表示であれば、ActiveWindowメソッドはNothingを返す。
- 'Outlookが非表示であれば、送信済みアイテムフォルダを開く。
- If .ActiveWindow Is Nothing Then
- 'Outlookの主要なオブジェクトであるNameSpaceオブジェクトを取得
- Dim myNameSpace As Outlook.Namespace
- Set myNameSpace = .GetNamespace("MAPI")
-
- '送信済みアイテムフォルダを取得
- 'これからメールを送信するので、先に送信済みアイテムフォルダを
- '開いておく。
- Dim myFolder As Outlook.Folder
- Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
-
- '送信済みアイテムフォルダを表示
- myFolder.Display
-
- 'Outlookは、最初に開いた画面サイズを最大だと勘違いして記憶して
- 'いるので、一度標準サイズに変更してから画面を最大化する。
- '送信済みアイテムの画面を最大化する。
- With .ActiveWindow
- .WindowState = olNormalWindow
- .WindowState = olMaximized
- End With
- End If
- End With
-
- '送信メールのオブジェクトを取得
- Dim myMailItem As Outlook.MailItem
- Set myMailItem = olApp.CreateItem(olMailItem)
-
- '添付ファイルのコレクションを取得
- Dim myAttachments As Outlook.Attachments
- Set myAttachments = myMailItem.Attachments
-
- '添付ファイルコレクションにPDFファイルを追加
- Dim AttachedFile As String
- AttachedFile = Range("C12").Value
- 'Outlook 2003以前であれば、リッチテキストメール(olFormatRichText)
- '作成時に
- '.BodyFormat = olFormatRichText
- 'として、AddメソッドでPosition:=～（～はLong型変数）とすることで、
- '添付ファイルの挿入位置を指定できたが、
- 'Outlook 2010以降では、その指定は無効になっている。
- 'つまり、リッチテキスト形式のメールは推奨されず、
- '使わないほうがいいという形式になっている。
- myAttachments.Add Source:=AttachedFile
-
- '送信メールの内容作成
- With myMailItem
- 'メールの表示形式はテキスト形式にする
- .BodyFormat = olFormatPlain
-
- '送信先を指定（To・CC・BCC）
- .To = toAddress
- .CC = ccAddress
- .BCC = bccAddress
-
- '件名を作成（件名１・件名２を合成）
- Dim Subject1 As String
- Subject1 = Range("C6").Value
-
- Dim Subject2 As String
- Subject2 = "(" & Format(Range("C7").Value, "m/d") & ")"
-
- Dim Subject As String
- Subject = Subject1 & Subject2
- .Subject = Subject
-
- '本文を作成（本文１・日付・本文２を合成）
- Dim MailBody1 As String
- MailBody1 = Replace(Range("C8").Value, vbLf, vbCrLf)
-
- Dim MailBodyDate As String
- MailBodyDate = Format(Range("C9").Value, "m/d")
-
- Dim MailBody2 As String
- MailBody2 = Replace(Range("C10").Value, vbLf, vbCrLf)
-
- Dim MailBody As String
- MailBody = MailBody1 & MailBodyDate & MailBody2
-
- '署名を指定
- Dim Signature As String
- Signature = Replace(Range("C11").Value, vbLf, vbCrLf)
-
- '本文と署名を合成
- .Body = MailBody & vbCrLf & vbCrLf & Signature & vbCrLf & vbCrLf
-
- '送信メールを表示
- .Display
- End With
-
- 'オブジェクトの解放
- Set myAttachments = Nothing
- Set myMailItem = Nothing
- Set myFolder = Nothing
- Set myNameSpace = Nothing
- Set olApp = Nothing
- End Sub
Option Explicit
'「ツール(T)」⇒「参照設定(R)...」から以下のライブラリにチェックを
'入れてください。
'「Microsoft Outlook 16.0 Object Library」（バージョンの数字は可変）
Public Sub S_AttachPDFFile()
'PDFファイル名を取得
'ButtonNameは実際にファイルを指定すると変化する。
'複数ファイルを添付したいときは、AllowMultiSelect = trueにする。
'InitialFileNameは最後にフォルダを指定することを表す「\」マークを
'付けるとダイアログのファイル名欄が空白になる。
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "送信するPDFファイルを添付してください"
.ButtonName = "PDF添付(&A)"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
'.InitialFileName = "C:\Users\amacoda\Documents\PDF ファイル\"
'フィルタでファイルの種類を「PDFファイル」に絞り込む。
'他のファイルを選択したい場合、それに応じたフィルタを設定する。
With .Filters
.Clear
.Add "PDFファイル", "*.pdf"
End With
'キャンセルが押されたらプログラムを終了
'キャンセルを押すと、Microsoftの解説によれば、「0」を返す。
'しかし、「OK」の時は「-1」を返すのだから、この場合は「False」を
'使っても特に問題はない。
If .Show = False Then Exit Sub
'選択したファイルのフルパスをセル「C12」に代入
'セルに直にファイルのフルパスの文字列を代入するのではなく、一度
'数に代入して代入するものがファイルのフルパスであることを明示
'している。
Dim FilePath As String
FilePath = .SelectedItems(1)
Range("C12").Value = FilePath
End With
End Sub
Public Sub S_CreateOutlookTextMail()
'PDFファイルが添付されていなければプログラムを終了
Select Case Range("C12").Value
'添付ファイル名の欄が空白の場合
Case ""
MsgBox "PDFファイルが添付されていません。" & vbCrLf & _
"送信するPDFファイルを添付してください。", _
vbOKOnly + vbExclamation, "メール送信管理"
Exit Sub
'添付ファイル名の拡張子が「.pdf」でない場合
Case Else
Dim Extension As String
Extension = LCase(Right(Range("C12").Value, 4))
If Extension <> ".pdf" Then
MsgBox "PDFファイルが添付されていません。" & vbCrLf & _
"ファイルの拡張子をよく確認して" & vbCrLf & _
"PDFファイルを添付してください。", _
vbOKOnly + vbExclamation, _
"メール送信管理"
Range("C12").Value = ""
Exit Sub
End If
End Select
'宛先が入力されていなければプログラムを終了
Dim toAddress As String
toAddress = Range("C3").Value
Dim ccAddress As String
ccAddress = Range("C4").Value
Dim bccAddress As String
bccAddress = Range("C5").Value
If toAddress = "" And ccAddress = "" And bccAddress = "" Then
MsgBox "宛先を入力してください。", vbOKOnly + vbExclamation, _
"メール送信管理"
Exit Sub
End If
'Outlook起動中であればそのままOutlookオブジェクトを取得
'Outlook未起動であればOutlookを起動 -> Outlookオブジェクトを取得
'Outlook未起動の状態でオブジェクトを取得すると、Outlookは非表示
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")
With olApp
'Outlookが非表示であれば、ActiveWindowメソッドはNothingを返す。
'Outlookが非表示であれば、送信済みアイテムフォルダを開く。
If .ActiveWindow Is Nothing Then
'Outlookの主要なオブジェクトであるNameSpaceオブジェクトを取得
Dim myNameSpace As Outlook.Namespace
Set myNameSpace = .GetNamespace("MAPI")
'送信済みアイテムフォルダを取得
'これからメールを送信するので、先に送信済みアイテムフォルダを
'開いておく。
Dim myFolder As Outlook.Folder
Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
'送信済みアイテムフォルダを表示
myFolder.Display
'Outlookは、最初に開いた画面サイズを最大だと勘違いして記憶して
'いるので、一度標準サイズに変更してから画面を最大化する。
'送信済みアイテムの画面を最大化する。
With .ActiveWindow
.WindowState = olNormalWindow
.WindowState = olMaximized
End With
End If
End With
'送信メールのオブジェクトを取得
Dim myMailItem As Outlook.MailItem
Set myMailItem = olApp.CreateItem(olMailItem)
'添付ファイルのコレクションを取得
Dim myAttachments As Outlook.Attachments
Set myAttachments = myMailItem.Attachments
'添付ファイルコレクションにPDFファイルを追加
Dim AttachedFile As String
AttachedFile = Range("C12").Value
'Outlook 2003以前であれば、リッチテキストメール(olFormatRichText)
'作成時に
'.BodyFormat = olFormatRichText
'として、AddメソッドでPosition:=～（～はLong型変数）とすることで、
'添付ファイルの挿入位置を指定できたが、
'Outlook 2010以降では、その指定は無効になっている。
'つまり、リッチテキスト形式のメールは推奨されず、
'使わないほうがいいという形式になっている。
myAttachments.Add Source:=AttachedFile
'送信メールの内容作成
With myMailItem
'メールの表示形式はテキスト形式にする
.BodyFormat = olFormatPlain
'送信先を指定（To・CC・BCC）
.To = toAddress
.CC = ccAddress
.BCC = bccAddress
'件名を作成（件名１・件名２を合成）
Dim Subject1 As String
Subject1 = Range("C6").Value
Dim Subject2 As String
Subject2 = "(" & Format(Range("C7").Value, "m/d") & ")"
Dim Subject As String
Subject = Subject1 & Subject2
.Subject = Subject
'本文を作成（本文１・日付・本文２を合成）
Dim MailBody1 As String
MailBody1 = Replace(Range("C8").Value, vbLf, vbCrLf)
Dim MailBodyDate As String
MailBodyDate = Format(Range("C9").Value, "m/d")
Dim MailBody2 As String
MailBody2 = Replace(Range("C10").Value, vbLf, vbCrLf)
Dim MailBody As String
MailBody = MailBody1 & MailBodyDate & MailBody2
'署名を指定
Dim Signature As String
Signature = Replace(Range("C11").Value, vbLf, vbCrLf)
'本文と署名を合成
.Body = MailBody & vbCrLf & vbCrLf & Signature & vbCrLf & vbCrLf
'送信メールを表示
.Display
End With
'オブジェクトの解放
Set myAttachments = Nothing
Set myMailItem = Nothing
Set myFolder = Nothing
Set myNameSpace = Nothing
Set olApp = Nothing
End Sub
VBAでOutlookテキストメールを作成するマクロの概説
このマクロはPDFファイルを添付するマクロとメールを作成するマクロから成り立っています。
このマクロで作成するメールの概要を示します。
この画像を見るとわかりやすいかもしれません。
・PDFファイルを1通添付します。
・宛先は、To、CC、BCCともに自由に設定できます。
・件名に前営業日の日付を自動入力します。
・本文の前半と後半の間に前営業日の日付を自動入力します。
・署名はOutlookから引用するのではなく、シート上に記入しておきます。
・メールを自動送信するのではなく、あくまで定型文を自動作成するのにとどめています。なお、自動送信は非常にカンタンにできてしまってかえって危険なのであえてしていません。
PDFファイル添付マクロの解説
PDFファイル名を取得
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "送信するPDFファイルを添付してください"
.ButtonName = "PDF添付(&A)"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
'.InitialFileName = "C:\Users\amacoda\Documents\PDF ファイル\"
～～～～～～～～～～～～～～～
End With<
- With Application.FileDialog(msoFileDialogFilePicker)
- .Title = "送信するPDFファイルを添付してください"
- .ButtonName = "PDF添付(&A)"
- .AllowMultiSelect = False
- .InitialView = msoFileDialogViewList
- '.InitialFileName = "C:\Users\amacoda\Documents\PDF ファイル\"
- ～～～～～～～～～～～～～～～
- End With<
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "送信するPDFファイルを添付してください"
.ButtonName = "PDF添付(&A)"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
'.InitialFileName = "C:\Users\amacoda\Documents\PDF ファイル\"
～～～～～～～～～～～～～～～
End With<
・ButtonNameプロパティに設定したボタン名は、最初は適用されずに「開く(O)」となっていますが、ファイルを選択すると変化し、「PDF添付(A)」となります。
・本マクロでは、「AllowMultiSelect = False」として単一のPDFファイルを添付していますが、複数のPDFファイルを添付したい場合は、「False」を「True」に変更すると、添付が可能になります。
・InitialFileNameプロパティはここではコメントにしていますが、最初にダイアログを開いたときに選択しておくファイルを指定することができます。例えば、
"C:\Users\amacoda\Documents\PDF ファイル\hoge.pdf"
を指定すると、ダイアログを開いたとき、hoge.pdfを選択します。
また、
"C:\Users\amacoda\Documents\PDF ファイル\"
とファイル名を指定せずにフォルダ名を指定すると、「PDF ファイル」フォルダは選択しますが、ファイルは選択しないので、ファイル名欄は空白になります。
フィルタでファイルの種類を「PDF ファイル」に絞り込む
With .Filters
.Clear
.Add "PDFファイル", "*.pdf"
End With
- With .Filters
- .Clear
- .Add "PDFファイル", "*.pdf"
- End With
With .Filters
.Clear
.Add "PDFファイル", "*.pdf"
End With
FiltersプロパティのAddメソッドのパラメータに「"PDFファイル", "*.pdf"」と文字列を追加すると、PDFファイルに絞り込みます。
もしも、エクセルファイルに絞り込むなら「"Excelファイル", "*.xlsx"」とします。
このフィルタは何個でも追加できるので、複数の種類のファイルを絞り込みに加えることができます。
キャンセルが押されたらプログラムを終了
If .Show = False Then Exit Sub
- If .Show = False Then Exit Sub
If .Show = False Then Exit Sub
ここに
「Displays a file dialog box and returns a Long indicating whether the user pressed the Action button (-1) or the Cancel button (0).」
とあるように、ファイルダイアログは実行ボタンを押したとき、Long型の値である「-1」を、キャンセルボタンを押したとき、同じくLong型の値である「0」を返します。
しかし、True の実態は「-1」、Falseの実態は「0」であることから、返り値をTrue／Falseで表現しても本マクロは動作します。
正確性が気になる方はｰ1／0で表現することをおススメします。
選択したファイルのフルパスをセル「C12」に代入
Dim FilePath As String
FilePath = .SelectedItems(1)
Range("C12").Value = FilePath- Dim FilePath As String
- FilePath = .SelectedItems(1)
- Range("C12").Value = FilePath
Dim FilePath As String
FilePath = .SelectedItems(1)
Range("C12").Value = FilePathここではファイルのフルパスをいきなりセルに代入することはしていませんが、次のようなやり方も
Range("C12").Value = .SelectedItems(1)- Range("C12").Value = .SelectedItems(1)
Range("C12").Value = .SelectedItems(1)まちがってはいませんし、本マクロのようなシンプルなマクロでは「あり」なのですが、いったんファイルのフルパスということがわかるような名前の変数「FilePath」にいったん値を格納してからセルに代入する「クセ」をつけておいたほうがよいでしょう。
メール作成マクロの解説
PDFファイルが添付されていなければプログラムを終了
Select Case Range("C12").Value
Case ""
～～～～～～～～～～～～～～
Case Else
～～～～～～～～～～～～～～～
End Select- Select Case Range("C12").Value
- Case ""
- ～～～～～～～～～～～～～～
- Case Else
- ～～～～～～～～～～～～～～～
- End Select
Select Case Range("C12").Value
Case ""
～～～～～～～～～～～～～～
Case Else
～～～～～～～～～～～～～～～
End Selectセル「C12」に入っているはずの値を評価します。
その値はファイルのフルパスなのですが、それが長さ0の文字列「""」の場合はこの処理を、それがPDFファイルのフルパスでない場合はこの処理をする、という分岐をSelect Case文を使って実現しています。
添付ファイル名欄が空白の場合
Case ""
MsgBox "PDFファイルが添付されていません。" & vbCrLf & _
"送信するPDFファイルを添付してください。", _
vbOKOnly + vbExclamation, "メール送信管理"
Exit Sub- Case ""
- MsgBox "PDFファイルが添付されていません。" & vbCrLf & _
- "送信するPDFファイルを添付してください。", _
- vbOKOnly + vbExclamation, "メール送信管理"
- Exit Sub
Case ""
MsgBox "PDFファイルが添付されていません。" & vbCrLf & _
"送信するPDFファイルを添付してください。", _
vbOKOnly + vbExclamation, "メール送信管理"
Exit Sub添付ファイル名欄が空白の場合、VBA的にいうと、長さ「0」の文字列が入っているといいます。
その場合、ファイルを添付してもらう必要があるため、警告メッセージを表示して本マクロを終了します。
添付ファイル名の拡張子が「.pdf」でない場合
Case Else
Dim Extension As String
Extension = LCase(Right(Range("C12").Value, 4))
If Extension <> ".pdf" Then
MsgBox "PDFファイルが添付されていません。" & vbCrLf & _
"ファイルの拡張子をよく確認して" & vbCrLf & _
"PDFファイルを添付してください。", _
vbOKOnly + vbExclamation, _
"メール送信管理"
Range("C12").Value = ""
Exit Sub
End If- Case Else
- Dim Extension As String
- Extension = LCase(Right(Range("C12").Value, 4))
- If Extension <> ".pdf" Then
- MsgBox "PDFファイルが添付されていません。" & vbCrLf & _
- "ファイルの拡張子をよく確認して" & vbCrLf & _
- "PDFファイルを添付してください。", _
- vbOKOnly + vbExclamation, _
- "メール送信管理"
- Range("C12").Value = ""
- Exit Sub
- End If
Case Else
Dim Extension As String
Extension = LCase(Right(Range("C12").Value, 4))
If Extension <> ".pdf" Then
MsgBox "PDFファイルが添付されていません。" & vbCrLf & _
"ファイルの拡張子をよく確認して" & vbCrLf & _
"PDFファイルを添付してください。", _
vbOKOnly + vbExclamation, _
"メール送信管理"
Range("C12").Value = ""
Exit Sub
End If添付ファイル名欄が空白でない場合、まず拡張子を取得します。
変数Extensionに、Right関数を使ってセルC12に入っている文字列の右から4文字を格納し、LCase関数を使って小文字化し、それを「.pdf」という文字列と比較して、結果が「.pdf」でないのであれば、警告メッセージを表示し、セルC12を空白にして本マクロを終了します。
宛先が入力されていなければプログラムを終了
Dim toAddress As String
toAddress = Range("C3").Value
Dim ccAddress As String
ccAddress = Range("C4").Value
Dim bccAddress As String
bccAddress = Range("C5").Value
If toAddress = "" And ccAddress = "" And bccAddress = "" Then
MsgBox "宛先を入力してください。", vbOKOnly + vbExclamation, _
"メール送信管理"
Exit Sub
End If- Dim toAddress As String
- toAddress = Range("C3").Value
- Dim ccAddress As String
- ccAddress = Range("C4").Value
- Dim bccAddress As String
- bccAddress = Range("C5").Value
- If toAddress = "" And ccAddress = "" And bccAddress = "" Then
- MsgBox "宛先を入力してください。", vbOKOnly + vbExclamation, _
- "メール送信管理"
- Exit Sub
- End If
Dim toAddress As String
toAddress = Range("C3").Value
Dim ccAddress As String
ccAddress = Range("C4").Value
Dim bccAddress As String
bccAddress = Range("C5").Value
If toAddress = "" And ccAddress = "" And bccAddress = "" Then
MsgBox "宛先を入力してください。", vbOKOnly + vbExclamation, _
"メール送信管理"
Exit Sub
End Ifセル「C3」「C4」「C5」の文字列をそれぞれ、toAddress、ccAddress、bccAddressという何の変数かわかりやすい名前の変数に代入し、それぞれが長さ「0」の文字列である、すなわち宛先がTo・CC・BCCのどれにも入っていない場合は、警告メッセージを表示して本マクロを終了します。
Outlookオブジェクトを取得
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")- Dim olApp As Outlook.Application
- Set olApp = CreateObject("Outlook.Application")
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")こういう場合にまっ先に思い浮かぶのはGetObject関数ですね。
GetObject([PathName], [Class])
- GetObject([PathName], [Class])
GetObject([PathName], [Class])
PathNameに長さ0の文字列「""」を指定すれば、CreateObjectと同等のことができると、ここには書いてあるのですが、なぜか会社の環境（Windows 7 + Office 2010）では、オブジェクトを取得することができませんでした。
しかたがないので、CreateObject関数でOutlookオブジェクトを取得すると、
1.もともと起動していたOutlookの場合は、そのウィンドウを表示したままオブジェクトを取得
2.起動していなかったOutlookの場合は、そのウィンドウを表示しないままオブジェクトを取得
と、ウィンドウの表示の有無という違いがありますが、オブジェクトを取得することはできます。。
Outlookが非表示であれば、送信済みアイテムフォルダを開く
With olApp
If .ActiveWindow Is Nothing Then
～～～～～～～～～～～～～～～
End If
End With
- With olApp
- If .ActiveWindow Is Nothing Then
- ～～～～～～～～～～～～～～～
- End If
- End With
With olApp
If .ActiveWindow Is Nothing Then
～～～～～～～～～～～～～～～
End If
End With
未起動のOutlookを起動させて、Outlookオブジェクトへの参照を変数に格納した場合、Outlookのウィンドウは非表示です
そのままでもいいんですが、使う方のわかりやすさのためにはやはりOutlookのウィンドウを表示したいですね。
OutlookのActiveWindowメソッドは、Outlookウィンドウのオブジェクト（Explorerオブジェクト、またはInspectorオブジェクト）を返します。
そこで、Is演算子を使ってNothingと比較して、Outlookウィンドウが非表示ならば、そのウィンドウを表示するという操作をしています。
Outlookの主要なオブジェクトであるNameSpaceオブジェクトを取得
Dim myNameSpace As Outlook.Namespace
Set myNameSpace = .GetNamespace("MAPI")- Dim myNameSpace As Outlook.Namespace
- Set myNameSpace = .GetNamespace("MAPI")
Dim myNameSpace As Outlook.Namespace
Set myNameSpace = .GetNamespace("MAPI")Outlookで一番重要なオブジェクトは2つあり、それはApplicationオブジェクトと、NameSpaceオブジェクトです。
Applicationオブジェクトのほうは、他のVBAをかじったことがある方なら慣れているでしょうから、最も重要な、すなわち主要なオブジェクトはNameSpaceオブジェクトだといえます。
NameSpaceオブジェクトさえ取得すれば、その膨大なプロパティとメソッドを自由に使えます。
NameSpaceオブジェクトの取得方法は、呪文のようの覚えてもかまわないと思います。GetNameSpaceメソッドのパラメータがサポートしているNameSpaceオブジェクトの種類は「MAPI」の1種類だけなので、他の書き方はありません。
送信済みアイテムフォルダを取得
Dim myFolder As Outlook.Folder
Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
- Dim myFolder As Outlook.Folder
- Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
Dim myFolder As Outlook.Folder
Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
これからメールを送信するので、先に送信済みアイテムフォルダを表示します。
GetDefaultFolderメソッドを使って送信済みアイテムフォルダを取得しますが、このメソッドのパラメータは、送信済みアイテムフォルダの他、予定表フォルダ、連絡先フォルダ、受信トレイフォルダなど、計20種類のフォルダを取得することを可能にしています。
送信済みアイテムフォルダを表示
myFolder.Display
命令文を見たまま、フォルダを表示します。送信済みアイテムフォルダ内の特定の項目の表示を要求しているのではないため、エラーを返しません。
送信済みアイテムの画面を最大化する
With .ActiveWindow
.WindowState = olNormalWindow
.WindowState = olMaximized
End With
- With .ActiveWindow
- .WindowState = olNormalWindow
- .WindowState = olMaximized
- End With
With .ActiveWindow
.WindowState = olNormalWindow
.WindowState = olMaximized
End With
Outlookは、最初に開いた画面サイズを最大だと勘違いして記憶しているので、一度標準サイズに変更してから画面を最大化します。
送信メールのオブジェクトを取得
Dim myMailItem As Outlook.MailItem
Set myMailItem = olApp.CreateItem(olMailItem)
- Dim myMailItem As Outlook.MailItem
- Set myMailItem = olApp.CreateItem(olMailItem)
Dim myMailItem As Outlook.MailItem
Set myMailItem = olApp.CreateItem(olMailItem)
本マクロの中で一番重要なオブジェクトを取得します。CreateItemメソッドで作成できるオブジェクトの種類は8種類あります。
添付ファイルのコレクションを取得
Dim myAttachments As Outlook.Attachments
Set myAttachments = myMailItem.Attachments
- Dim myAttachments As Outlook.Attachments
- Set myAttachments = myMailItem.Attachments
Dim myAttachments As Outlook.Attachments
Set myAttachments = myMailItem.Attachments
添付ファイルのコレクションを取得しますが、この時点ではこのコレクションは空です。
添付ファイルコレクションにPDFファイルを追加
Dim AttachedFile As String
AttachedFile = Range("C12").Value
myAttachments.Add Source:=AttachedFile- Dim AttachedFile As String
- AttachedFile = Range("C12").Value
- myAttachments.Add Source:=AttachedFile
Dim AttachedFile As String
AttachedFile = Range("C12").Value
myAttachments.Add Source:=AttachedFileOutlook2003以前であれば、リッチテキストメール(olFormatRichText)作成時に
BodyFormat = olFormatRichText
として、AddメソッドでPosition:=～（～はLong型変数）とすることで、添付ファイルの挿入位置を指定できましたが、Outlook2010以降では、その指定は無効になっているようです。
つまり、リッチテキスト形式のメールは推奨されず、使わないほうがいいという形式になっているといえます。
送信メールの内容作成
With myMailItem
～～～～～～～～～～～～～～～
End With
- With myMailItem
- ～～～～～～～～～～～～～～～
- End With
With myMailItem
～～～～～～～～～～～～～～～
End With
エクセル上に作成したメールの内容をアウトルックに流し込むために処理をおこないます。
メールの表示形式はテキスト形式にする
.BodyFormat = olFormatPlain
- .BodyFormat = olFormatPlain
.BodyFormat = olFormatPlain
ここでは、テキスト形式にしましたが、HTML形式も選択できます。
しかし、HTML形式の場合、エクセル上にHTML言語の仕様に沿った形でマークアップしておく必要があります。
送信先を指定（To・CC・BCC）
.To = toAddress
.CC = ccAddress
.BCC = bccAddress
- .To = toAddress
- .CC = ccAddress
- .BCC = bccAddress
.To = toAddress
.CC = ccAddress
.BCC = bccAddress
変数に格納しておいた送信先のアドレスをそれぞれのプロパティに代入します。
件名を作成（件名１・件名２を合成）
Dim Subject1 As String
Subject1 = Range("C6").Value
Dim Subject2 As String
Subject2 = "(" & Format(Range("C7").Value, "m/d") & ")"
Dim Subject As String
Subject = Subject1 & Subject2
.Subject = Subject- Dim Subject1 As String
- Subject1 = Range("C6").Value
- Dim Subject2 As String
- Subject2 = "(" & Format(Range("C7").Value, "m/d") & ")"
- Dim Subject As String
- Subject = Subject1 & Subject2
- .Subject = Subject
Dim Subject1 As String
Subject1 = Range("C6").Value
Dim Subject2 As String
Subject2 = "(" & Format(Range("C7").Value, "m/d") & ")"
Dim Subject As String
Subject = Subject1 & Subject2
.Subject = Subject件名２の書式を整え、件名１と件名２を合成して、Subjectプロパティに代入します。
本文を作成（本文１・日付・本文２を合成）
Dim MailBody1 As String
MailBody1 = Replace(Range("C8").Value, vbLf, vbCrLf)
Dim MailBodyDate As String
MailBodyDate = Format(Range("C9").Value, "m/d")
Dim MailBody2 As String
MailBody2 = Replace(Range("C10").Value, vbLf, vbCrLf)
Dim MailBody As String
MailBody = MailBody1 & MailBodyDate & MailBody2- Dim MailBody1 As String
- MailBody1 = Replace(Range("C8").Value, vbLf, vbCrLf)
- Dim MailBodyDate As String
- MailBodyDate = Format(Range("C9").Value, "m/d")
- Dim MailBody2 As String
- MailBody2 = Replace(Range("C10").Value, vbLf, vbCrLf)
- Dim MailBody As String
- MailBody = MailBody1 & MailBodyDate & MailBody2
Dim MailBody1 As String
MailBody1 = Replace(Range("C8").Value, vbLf, vbCrLf)
Dim MailBodyDate As String
MailBodyDate = Format(Range("C9").Value, "m/d")
Dim MailBody2 As String
MailBody2 = Replace(Range("C10").Value, vbLf, vbCrLf)
Dim MailBody As String
MailBody = MailBody1 & MailBodyDate & MailBody2日付の書式を整え、本文１・日付・本文２を合成します。
ひとつ注意するのは、エクセルのセル内改行の形式はラインフィード（Line Feed）であるのに対して、アウトルックのメールアイテム内の改行形式はキャリッジリターン・ラインフィード（Carriage Return, Line Feed）ということです。
このため、本文１・本文２の書式をReplace関数を用いて整えています。
署名を指定
Dim Signature As String
Signature = Replace(Range("C11").Value, vbLf, vbCrLf)- Dim Signature As String
- Signature = Replace(Range("C11").Value, vbLf, vbCrLf)
Dim Signature As String
Signature = Replace(Range("C11").Value, vbLf, vbCrLf)本文と同じように署名の形式をReplace関数で整えます。
本文と署名を合成
.Body = MailBody & vbCrLf & vbCrLf & Signature & vbCrLf & vbCrLf
- .Body = MailBody & vbCrLf & vbCrLf & Signature & vbCrLf & vbCrLf
.Body = MailBody & vbCrLf & vbCrLf & Signature & vbCrLf & vbCrLf
改行を表すvbCrLfは、送信メールの見た目を整えるために挿入しています。
送信メールを表示
.Display
送信メールを実際に送信してしまう代わりに、画面上で確認するために表示します。
マクロ上で送信までしてしまいたい場合は
.Send
と入力すれば送信できます。しかし、画面上で確認もせずに送信するのは大変危険なので、このコマンドは使わないほうがよいと思います。
オブジェクトの解放
Set myAttachments = Nothing
Set myMailItem = Nothing
Set myFolder = Nothing
Set myNameSpace = Nothing
Set olApp = Nothing
- Set myAttachments = Nothing
- Set myMailItem = Nothing
- Set myFolder = Nothing
- Set myNameSpace = Nothing
- Set olApp = Nothing
Set myAttachments = Nothing
Set myMailItem = Nothing
Set myFolder = Nothing
Set myNameSpace = Nothing
Set olApp = Nothing
これまでに使ったオブジェクトを解放し、片づけます。
おわりに
これはそんなに難しいマクロではありませんが、アウトルックのオブジェクトをいじること自体に慣れていない方が大半ではないでしょうか。
覚え方としては、アウトルックのオブジェクトの中で何が重要か（どれを先に覚えるべきか）ググって確認し、あとはオブジェクトブラウザとヘルプ（できれば英語版のほうのウェブヘルプ）を調べれば、覚えたいものを早く覚えられるのではないでしょうか。
最初は、何も覚えていないので、やりたいこともシンプルだと思います。
私が最初に思いついたのは本マクロでした。他には、受信したメールを、受信した後の任意の時点で、あとからフォルダにメール振り分けするマクロが代表的なマクロだと思います。
関連
コメントを残す