【コピペでOK】エクセルから添付付きOutlookメール自動作成！VBA(マクロ)コード・DL版あり！

Outlookのメールで添付ファイルをいちいち貼り付けるのがめんどくさい…
添付ファイル付きメールを送る作業を自動化したい！

Outlookでメールを送るとき、地味に面倒なのが添付ファイルです。ファイルを張り付けるだけですが、量が多いと結構手間になる作業です。そんな悩みを解決するのが、VBAを使ったメール自動作成です。

このVBAコードをコピペするだけで、Outlookの添付付きメールを簡単に作成できます。さらに、別で紹介したフォルダのファイル取得VBAを使えば、メールごとに別の添付をつける作業も効率化することができます！

「VBAは初めてでよく分からない…」という方でも、そのまま使えるエクセルファイルも用意しています。まずはダウンロードして試してみてください。

このブログでは、効率化に関する様々な情報を発信しています。AIの情報等も配信していますので、そちらもぜひ参考にしてみてください！

【結論】コピペで使える添付付きメール作成VBA

以下のコードをコピペするだけで、Outlookの添付付きメールを自動作成できます。

実行の際、あらかじめ宛先／CCなどの項目の作成が必要です。詳しくはこの後紹介します。

Sub SendEmail_Attachment()
    Dim olApp As Outlook.Application
    Dim olMail As Outlook.MailItem
    Dim ws As Worksheet
    Dim lRow As Long, i As Long
    Dim strTo As String, strCC As String, strSub As String, strBody As String
    Dim strAttachment As String
    
    ' Outlookのインスタンス取得（すでに起動していればそれを使う）
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = New Outlook.Application
    End If
    On Error GoTo 0
    
    ' メール送信リストが記載されたシートを設定
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' 最終行を取得
    lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    
    ' 1行ずつデータを取得し、メールを送信
    For i = 2 To lRow
        ' 宛先・CC・件名・本文を取得
        strTo = ws.Cells(i, 1).Value
        strCC = ws.Cells(i, 2).Value
        strSub = ws.Cells(i, 3).Value
        strBody = ws.Cells(i, 4).Value & vbCrLf _
                  & ws.Cells(i, 5).Value & vbCrLf _
                  & ws.Cells(i, 6).Value & vbCrLf _
                  & ws.Cells(i, 7).Value

        ' 添付ファイルパス（8列目に記載されている場合）
        strAttachment = ws.Cells(i, 8).Value
        
        ' メール作成
        Set olMail = olApp.CreateItem(olMailItem)
        With olMail
            .To = strTo
            .CC = strCC
            .Subject = strSub
            .Body = strBody
            
            ' 添付ファイルがある場合に追加
            If strAttachment <> "" And Dir(strAttachment) <> "" Then
                .Attachments.Add strAttachment
            End If
            
            .Display ' メールを表示
            '.Send ' 自動送信する場合はコメントアウトを外す
        End With
        
        ' メモリ解放
        Set olMail = Nothing
    Next i

Cleanup:
    ' Outlookアプリケーション解放
    Set olApp = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbExclamation
    Resume Cleanup
End Sub