【VBA】Excelのアドレス帳などからOutlookでメールを送信する

こんにちは、Ryoです。
Excelで住所録などを管理している場合、共通した連絡事項や報告内容などは登録してあるメールアドレスを元にメール送信したいこともあるかと思います。VBAではCreateObject関数／CreateItemメソッドを使うことで実行できますので、今回はその内容について書いていきます。

1.サンプル概要
2.サンプルコード
- ◆ファイルを添付する場合
3.まとめ

1.サンプル概要

サンプルとしてA列に「Name」（例では社名）、B列に「Address」の簡易的な表を準備していますので、この表を元にメールアイテムを作成してみます。

架空Mail Addressのサンプルなので、Displayメソッドを使用して作成したメールを送らずに表示させた結果が以下になります。

この通り、表を元にメールが作成されています。

私のメールアドレス宛にsendメソッドを使って実際送信してみても、以下の通り受信出来ています。

また、ファイルを添付したい場合はAttachmentsプロパティを使用することで対応できます。

サンプルの動作概要としては以上ですので、以下にこれらの内容について書いていきます。

2.サンプルコード

Sub Sample1()

  Dim outlookApp As Object
  Dim Mail_Item As Object
  
  'Outlookを起動する
  Set outlookApp = CreateObject("Outlook.Application")
   
  For i = 1 To 5
     'メールアイテムを作成
     '詳細は公式URL参照
     'https://docs.microsoft.com/ja-jp/office/vba/api/outlook.application.createitem
     Set Mail_Item = outlookApp.CreateItem(0)
        With Mail_Item
         'セルB2の値を「宛先」（To)に指定
         'Type=2→CC,Type=3→BCC
         .Recipients.Add(Cells(i + 1, 2).Value).Type = 1
         
         'タイトルの設定
         .Subject = "テスト送信" & i
         
         '本文へセルA2の値（社名や氏名など）と文章の設定
         .Body = Cells(i + 1, 1).Value & "様" & vbCrLf _
          & "いつもお世話になっております。テスト送信です。"
         
         'メールを送信
         '.Send
         
         '↓送信せずに作成したメールを表示したい場合は
         '　Displayメソッドを使用する↓
         .Display
         
         '繰り返し処理で複数送信を実行する際は処理毎に
         '待ち時間を設定すると、処理順に送信できる
         '（本サンプルではWait 1sec）
         Application.Wait Now + TimeValue("00:00:01")
       End With
  Next i
      
End Sub

先ずCreateObject関数でOutlookを起動します。起動させるといってもOutlookが未起動だったら自動的に立ち上がるというものではないので、バックグラウンドで処理されるようになります。

Set outlookApp = CreateObject(“Outlook.Application”)

次にOutlookのメールアイテムを作成しますので、CreateItemメソッドを使用し引数に「０」を指定します。このCreateItemメソッド詳細については、こちらの公式HPがわかりやすいのでご参照ください。

後はRecipientsプロパティでメールの「宛先（To)」にセルB列の値を指定、Subjectプロパティにメールタイトルを設定、Bodyプロパティにメール本文を指定します。

.Recipients.Add(Cells(i + 1, 2).Value).Type = 1　・・・宛先
.Subject = “テスト送信” & i　・・・タイトル
.Body = Cells(i + 1, 1).Value & “様” & vbCrLf _　・・・本文
& “いつもお世話になっております。テスト送信です。”

ちなみにRecipientsプロパティで使用するTypeプロパティですが、「1」は宛先、「2」はCC、「３」はBCCを指定しますので、用途に応じて使い分けます。

最後にメールを送信する場合はSendメソッドを使用すればOKですが、送信前の状態表示（作成したメール表示）の場合はDisplayメソッドを使用します。サンプルではSendメソッドをコメント、Displayメソッドを有効にしていますのでメール送信したい場合はDisplayメソッドを削除（またはコメント化）しSendメソッドを有効にすればOKです。

また、繰り返し処理を行う都合上、処理毎に待ち時間（タイマー）を設定しておくと、処理順にメールが送信されますのでご参考までに。

Application.Wait Now + TimeValue(“00:00:01”)・・・1sec設定

◆ファイルを添付する場合

ファイルを添付する場合はAttachmentsプロパティを使用します。

Sub Sample2()

'※※ファイルを添付したい場合の処理※※

  Dim outlookApp As Object
  Dim Mail_Item As Object

  Set outlookApp = CreateObject("Outlook.Application")
   
  For i = 1 To 5
     Set Mail_Item = outlookApp.CreateItem(0)
        With Mail_Item
         .Recipients.Add(Cells(i + 1, 2).Value).Type = 1
         .Subject = "テスト送信" & i
         .Body = Cells(i + 1, 1).Value & "様" & vbCrLf _
          & "いつもお世話になっております。テスト送信です。"
       
       '↓↓追加部分ここから↓↓
          'Attachmentsプロパティを使用し添付したい
          'ファイルを指定する
          '（本サンプルでは実行ブックと同保存先にある
          '　Sample00.xlsxを指定し添付する）
          .Attachments.Add ThisWorkbook.Path _
          & "\Sample00.xlsx"
        '↑↑ここまで↑↑
         
         .Send
         Application.Wait Now + TimeValue("00:00:01")
       End With
  Next i
      
End Sub

サンプルコード内コメントに記載している通り、Attachmentsプロパティを使用して添付したいファイルを指定すればOKです。