【EXCEL VBA】outlookメール作成。to,cc,bccの複数宛先セルの設定方法

仕事でEXCELを使う方は多いと思います。

毎日似たようなデータ更新があって、チェック後に関係部署へ添付資料を付けてメール送信・・。

私にも同じような定型業務があります。

最後にメールを送信する際にたまに宛先アドレスに追加更新があり、エクセル原本のアドレス帳を毎回参照してメールを送らなければならい煩わしさ・・。

何とか少しでも自動化できないか、VBAを使って自動メール作成を検討してみました。

VBAは書籍を中心に勉強中ですので、誤りがあったり、もっと良い方法もあるかもしれませんがご参考にしていただけると幸いです。（自身の備忘録みたいなもんです。）

★　TECH::CAMPの即戦力エンジニア養成プログラム【TECH::EXPERT】

【EXCEL VBA】outlookメール作成。to,cc,bccの複数宛先セルの設定方法

エクセルのアドレス帳に保存されている宛先にメール設定をして定型本文や添付ファイルを付けてメール作成をするプログラムです。

①別に保存されているエクセルのアドレス帳を起動させ
②TO,CC,BBCに対応したメールアドレスを取得し
③outlookメールに設定する
④ついでに添付ファイルも設定


Sub outlookメール作成()
'OUTLOOK Mailで必要な宣言
Dim objMail As New Outlook.Application
Dim myMail As Outlook.MailItem
Set myMail = objMail.CreateItem(olMailItem)

'TO、CC、BCC設定を格納するための配列を宣言
Dim TO_add() As Variant
Dim CC_add() As Variant
Dim BCC_add() As Variant

'for分のループで必要な宣言
Dim i As Long
Dim x As Long
Dim y As Long
Dim z As Long

'アドレス帳のエクセルを開くための宣言
Dim frWB As Workbook
Dim Rngrow As Long


'アドレス帳を展開
Address = "エクセルのアドレス帳のファイルパス\address.xlsx"
Set frWB = Workbooks.Open(Address)

'アドレス帳のヘッダー行を除いたデータをRngへ格納
Set Rng = Range("A2").CurrentRegion.Offset(1)

'Rngデータの行数をRngrowへ格納
Rngrow = Range("A2").CurrentRegion.Offset(1).Row

'要素数を定義していない配列に要素数を設定
ReDim TO_add(0 To Rngrow)
ReDim CC_add(0 To Rngrow)
ReDim BCC_add(0 To Rngrow)

x = 0
y = 0
z = 0

For i = 1 To Rng.Rows.Count - 1

'TOの場合は、TO_add(x)の配列に格納
If Rng.Cells(i, 1).Value = "TO" Then
    'MsgBox Rng.Cells(i, 2).Value
    TO_add(x) = Rng.Cells(i, 2)
    x = x + 1

'CCの場合は、CC_add(y)の配列に格納
ElseIf Rng.Cells(i, 1).Value = "CC" Then
    CC_add(y) = Rng.Cells(i, 2)
    y = y + 1

'BCCの場合は、BCC_add(z)の配列に格納
Else: Rng.Cells(i, 1).Value = "BCC"
    BCC_add(z) = Rng.Cells(i, 2)
    z = z + 1
End If
Next i

'配列をコンマ区切りに変更して格納
send_to = Join(TO_add, ",")
send_cc = Join(CC_add, ",")
send_bcc = Join(BCC_add, ",")

    
'メールの作成
With myMail
.To = send_to       'TO設定
.CC = send_cc       'CC設定
.BCC = send_bcc     'BCC設定

'件名を設定
.Subject = "件名を表示"

'本文を設定
.Body = "本文を表示"

'添付ファイルの設定
.Attachments.Add "添付ファイルのパス/添付ファイル" 
.Display

End With
End Sub

アドレス帳のTOやCC、BCCが追加削除されても振り分けてくれます。

また、件名や本文に関しても毎回同じ内容ならば、特定のセルに記載しておいて値を設定してあげればよいと思います。

参考にしていただければ幸いです。

リンク