【VBA】メール作成の自動化（ExcelとOutlookの連携）

2023年8月27日 12:07

１. はじめに

問題意識ときっかけ
１日の仕事のうちメールの作成には多くの時間を割いています。細切れの時間にやることが多く中断させられることも多いため、自動化を試みました。

２. 今回やりたいこと

（１）リストの宛先、件名、本文のリストからメールを自動で作成する。
（２）宛先、件名、本文は、リストから選択した分類を検索値として別のシートから表引き（VLOOKUP）する。
（３）別のシートにある送付先グループ、メール分類（件名＋本文のテンプレート）を更新したら、自動でメール作成のシートにあるプルダウンリストへ反映する。

３. コードと実行画面

（１）メールの作成

Sub メール作成()
Application.ScreenUpdating = False　'描画を停止する（処理を速くするための手続き）
Dim myOL As New Outlook.Application
Dim myMail As Outlook.MailItem
Dim i As Long
Dim Filename As String
    
Worksheets("メール作成").Select
For i = 5 To Cells(Rows.Count, 1).End(xlUp).Row　'5行目以降のリストから個々のメールを作成
        Set myMail = myOL.CreateItem(olMailItem)
        With myMail
            .To = Cells(i, 3).Value　'宛先
            .CC = Cells(i, 4).Value　'CC
            .Subject = Range("B2").Value　'件名
            .Body = Cells(i, 2).Value & vbCrLf & vbCrLf & _　'本文
             Range("C2").Value
            .BodyFormat = olFormatHTML　'本文の形式
            .Display　'作成したメールを表示する
        End With
        Set myMail = Nothing
Next i
    
Application.ScreenUpdating = True　'描画を再開する
End Sub

（２）送付先グループの更新

Sub 送付先グループを更新()

Dim ListArray() As Variant
Dim ListStr As String
Dim MaxRow As Long
Dim i As Long
 
Worksheets("メール作成").Select
'既存の入力規則を削除
Range("A5").Validation.Delete
     
'データを取得する
Worksheets("送付先リスト").Select
MaxRow = Cells(Rows.Count, 1).End(xlUp).Row
ReDim ListArray(MaxRow - 1)
    
For i = 2 To MaxRow　'2行目1列目から最終行までデータを取得
    ListArray(i - 1) = Cells(i, 1).Value
Next i
ListStr = Join(ListArray, ",")　'リスト形式をカンマ区切りへ変換して代入
     
Worksheets("メール作成").Select
'入力規則を設定
Range("A5").Validation.Add Type:=xlValidateList, Formula1:=ListStr
 
End Sub

**１列目に変更があった時にマクロ（送付先グループを更新）を実行**
※作成場所は標準モジュールではなく、Worksheetオブジェクト（送付先リスト）

（３）メール分類の更新

Sub メールの分類を更新()

Dim ListArray() As Variant
Dim ListStr As String
Dim MaxRow  As Long
Dim i As Long
 
Worksheets("メール作成").Select
'既存の入力規則を削除
Range("A2").Validation.Delete
     
'データを取得する
Worksheets("件名及び本文").Select
MaxRow = Cells(Rows.Count, 1).End(xlUp).Row
ReDim ListArray(MaxRow - 1)
    
For i = 2 To MaxRow　'2行目1列目から最終行までデータを取得
    ListArray(i - 1) = Cells(i, 1).Value
Next i
ListStr = Join(ListArray, ",")　'リスト形式をカンマ区切りへ変換して代入
     
Worksheets("メール作成").Select
'入力規則を設定
Range("A2").Validation.Add Type:=xlValidateList, Formula1:=ListStr
 
End Sub

**１列目に変更があった時にマクロ（メールの分類を更新）を実行**
※作成場所は標準モジュールではなく、Worksheetオブジェクト（件名及び本文）

４. おわりに

今回は、メール作成の自動化について紹介しました。
宛先や本文のリストがあるシートを更新すると、メール作成のシートにも自動で反映される工夫を施しました。
今回紹介したマクロは、メールのパターンが蓄積されるほど効果を発揮します。また、過去の類似のメールを探すときのデータベースとしても活用できます。

興味を持たれた方は、ぜひご活用ください。
また、コメント等いただけますと今後の励みになります。

５. 参考にしたサイト

この記事が気に入ったらサポートをしてみませんか？