SEの転職活動で使うべきサイト・エージェント 目指せ年収アップ
SEの転職活動で使うべきサイト・エージェント 目指せ年収アップ
東南アジアをバックパッカーしながら転職活動をした記録
東南アジアをバックパッカーしながら転職活動をした記録
7年目で初の転職活動 2カ月で内定獲得した記録
7年目で初の転職活動 2カ月で内定獲得した記録
おすすめのプログラミングスクール めざせ就職・年収アップ!
おすすめのプログラミングスクール めざせ就職・年収アップ!
メンズクリア2年通い放題入会! その後のヒゲ状況(不定期更新)
メンズクリア2年通い放題入会! その後のヒゲ状況(不定期更新)
ブログ開始3年が経った月収が1万超えてた!
ブログ開始3年が経った月収が1万超えてた!
プログラミング独学・スクール・就職(目次)
プログラミング独学・スクール・就職(目次)
previous arrowprevious arrow
next arrownext arrow
 
Shadow
VBA

Excel VBA メール送信ツール(Outlook)

VBAでOutlookのメール送信について紹介します。

自動でOutlookのメール送信するツールを作ってみました。

実際に作ったファイルはこちらから無料でダウンロードできます。

メール(Outlook)用の参照設定

ファイル用もフォルダ用もダイアログを開くに参照設定を必要です。

手順はコードエディターから「ツール(T)」→「参照設定(R)」と移動します。

その後、Microsoft Outlook 16.0 Object Libraryにチェックを付けておいてください。

16.0はバージョンに寄ります。

メール(Outlook)送信処理のコード

処理の流れは以下の順です。

①メール情報(件名、宛先など)を取得
②メールに情報をセットする
③添付ファイルを貼り付ける
④メールを送信する
⑤次のエクセルシートの情報を読取って①から~④を繰り返す

コード

'==============================
'目的    :シート分のメールを送信する
'==============================
Sub SendMail_Click()
  
  Dim MyDir As String                 '自分のファイルが存在するディレクトリ格納用
  Dim i As Long                     'ループ用変数
  Dim j As Long                     'ループ用変数
  Dim SheetCnt As Long                 'シート数を格納する変数
  Dim SheetName As String               'シート名を格納する変数
  
  Dim ToAddress As String               'Toアドレス用の変数
  Dim CcAddress As String               'Ccアドレス用の変数
  Dim BccAddress As String              'Bccアドレス用の変数
  Dim Subject As String                '件名用の変数
  Dim MailBody As String               'メール本文用の変数
  Dim Signature As String              '署名用の変数
  Dim OutlookObj As Outlook.Application      'Outlookで使用するオブジェクト生成
  Dim MailItemObj As Outlook.MailItem       'Outlookで使用するオブジェクト生成
  Dim Attachments As Outlook.Attachments     'Outlookで使用するオブジェクト生成
  Dim AttachmentPath As String           '添付ファイルの格納用変数
  Dim AttachmentsPath() As String         '添付ファイルの格納配列
  
  
  '自分の配置されているパスを取得
  MyDir = ThisWorkbook.Path
  
  'シート件数を取得
  SheetCnt = ThisWorkbook.Sheets.Count

  '-------シート枚数分ループ(2枚目のシートから)-------
  For i = 2 To SheetCnt
  
    'シート名を取得
    SheetName = Sheets(i).Name

    '-------メール情報を取得-------
    ToAddress = Sheets(i).Range("Mail_TO").Value         'To宛先
    CcAddress = Sheets(i).Range("Mail_CC").Value         'cc宛先
    BccAddress = Sheets(i).Range("Mail_BCC").Value        'bcc宛先
    Subject = "【" & SheetName & "様】" & _
            Sheets(i).Range("Mail_Subject").Value     '件名
    MailBody = Sheets(i).Range("Mail_Body").Value        'メール本文
    Signature = Sheets(i).Range("Mail_Signature").Value     '署名
  
    '-------メールに情報をセットする-------
    Set OutlookObj = CreateObject("Outlook.Application")
    Set MailItemObj = OutlookObj.CreateItem(olMailItem)
    MailItemObj.BodyFormat = 2                       'HTML形式に変更
    MailItemObj.To = ToAddress                       'to宛先をセット
    MailItemObj.CC = CcAddress                       'cc宛先をセット
    MailItemObj.BCC = BccAddress                      'bcc宛先をセット
    MailItemObj.Subject = Subject                      '件名をセット
    MailItemObj.Body = MailBody & vbCrLf & vbCrLf & Signature    '本文+署名
    
    '-------添付ファイルを貼り付ける-------'
    'オブジェクト生成
    Set Attachments = MailItemObj.Attachments
    
    '[yyyymmdd_会社名].[拡張子]を検索し、取得する'
    AttachmentsPath() = FileSearch(Format(Now(), "yyyymmdd") & "_" & SheetName & ".*", MyDir & "\添付ファイル\") '"
    

        If AttachmentsPath(0) = "dummy" Then
            '添付ファイルが一件もなければ、次のメール処理へ行く(発注連絡が不要なため)
            GoTo nextDO
        Else
            '添付ファイルが一件でもあれば添付
    
                'ファイル件数分ループして添付する
                For j = 0 To UBound(AttachmentsPath())
                    'ファイルパスを取得
                    AttachmentPath = AttachmentsPath(j)
    
                    'ファイルを添付
                    Attachments.Add AttachmentPath
    
                Next j
    
        End If
  
    '-------メールを送信する-------
    MailItemObj.Send
  
    '-------Outlookを閉じる(オブジェクトを解放)---
    Set OutlookObj = Nothing
    Set MailItemObj = Nothing
    
nextDO:
  Next i
  
  MsgBox "送信が完了しました。"
  
End Sub

解説

メール情報を取得

重要なポイントは名前の定義をしていることです。

宛先Toであれば「Mail_TO」のようにすべてのシートに設定がしてあります。

各シートに全て同じ名前を付けることで同じ処理をシートごとに繰り返せるようにしています。

そして各シートの値は変数に格納していく処理になっています。

※シートをコピーして増やしても名前の定義は引き継がれるため処理に問題はありません。

メールに情報をセットする

Outlookのオブジェクトを生成していま。

その後、それぞれToや本文の情報をOutlookのオブジェクトにセットしていっています。

添付ファイルを貼り付ける

まず添付ファイルのオブジェクト生成しています。

FileSearchメソッドを使って、添付ファイルのパスを取得しメールのオブジェクトに張り付ける処理を行っています。

FileSearchは後で説明を記載しています。

その後、添付ファイルがない場合、メールは送らず次のシートを処理するようになっています。

※発注連絡という想定なので、発注書の添付ファイルがなければ連絡はする必要がないから送らないという考え方です。

メールを送信する・Outlookを閉じる

最後にメールを送信します。

その後、作成したオブジェクトは破棄して次のメール作成・送信処理へ行きます。

メール添付ファイル取得 FileSearchメソッド

送信対象のファイル([yyyymmdd_シート名.拡張子]フォーマット)のファイル名を検索し配列に格納する処理です。

検索する場所は「..\VBA Outlookメール送信\添付ファイル」以下のみです。

他の場所に配置したファイルは添付ファイルとして検索されません。

コード

'==============================
'目的    :添付ファイルを検索し、ファイルのパスを取得する
'引数    :SearchText         検索するファイル名
'      :SearchPath         検索するパス
'戻り値   : ファイルパスの配列
'==============================
Private Function FileSearch(SearchText As String, SearchPath As String) As String()
    Dim FileName As String
    Dim Cnt As Long
    Dim Files() As String                         'ファイルパス格納用配列
    
    '中身をダミー値でセット
    ReDim Files(0)
    Files(0) = "dummy"
    
    'ファイルを検索
    FileName = Dir(SearchPath & "\" & SearchText)
    
    Do While FileName <> ""
        
        'ファイル名を返却用配列に格納
        ReDim Preserve Files(Cnt) As String
        Files(Cnt) = SearchPath & FileName
        Cnt = Cnt + 1
        
        ' 次のファイル名を参照
        FileName = Dir()
    Loop

  FileSearch = Files()
  
End Function

解説

引数として受け取った検索フォルダ(SearchPath)を検索条件(SearchText)を元に検索します。

見つかったファイルのパスを配列に格納していきます。

検索条件に一致するファイルが見つからなくなったら配列を呼び出し元に返しています。

送信結果

送信結果はこんなメールです。

メール送信と言いつつガチガチに業務を想定したツールになってしまっています…

使えそうなところをアレンジしていってみてください。

おすすめのプログラミングスクール めざせ就職・年収アップ! プログラミングを独学でされている人は意外と多いです。 ただ、プログラミングの独学は簡単にはいきません。 自分だけの力...
プログラミング初心者の独学方法 文系卒の経験談 私はIT系の会社に勤めて4年目ですが、最初の1年は開発をさせてもらえませんでした。 文系卒でプログラミング経験はなかったの...
プログラミングの独学とはエラーとの闘い プログラミングを勉強し始めた初心者の方はつまづくことが多いと思います。 私も最初はエラーが出るたびにいちいちビビッて、意味...

・【エクセルVBA】Outlookでメールを作成・送信する方法
https://tonari-it.com/excel-vba-outlook-mail-send/
・VBAでメールを自動送信!エクセルマクロでoutlook操作する方法
http://www.fastclassinfo.com/entry/vba_outlook_sendmail
・シートを指定してRangeを取得する
https://www.relief.jp/docs/excel-vba-get-range-specific-sheet.html
・PDF発注書テンプレート
https://pdf.wondershare.jp/templates/purchase-order-template.html
・FileSystemObjectオブジェクト – FileExistsメソッド
http://officetanaka.net/excel/vba/filesystemobject/filesystemobject10.htm
・ファイルの一覧を取得する
http://officetanaka.net/excel/vba/file/file07.htm

 

Excel VBA メール送信ツール(フリーメール)VBAでメール送信について紹介します。 自動でメール送信するツールを作ってみました。 今回はOutlookではなくフリーメー...
ABOUT ME
LooseCarrot
LooseCarrot
ブログ運営をしているLooseCarrotです。 興味のあることにトライして発信していきます! プロフィール

関連している記事