エクセルVBAでOutlookへメール転送　差し込みし連続送信

Excel VBA塾【動画✕本で学ぶ! 】 ~初心者OK! 仕事をマクロで自動化する12のレッスン

１）はじめに

VB.NETでOutlookへメール転送ソフト（ここをクリック）を作成してみましたが、今回はエクセルのＶＢＡで転送できるものを作成します。
エクセルで作成しますので、エクセルと送信設定済のアウトルックは必要です。windows10 Office 2021で確認していますが
windows11　Office 2019でも動作します。

VB.NETで作成したもと機能は同じで　差し込み１～４まで設定可能で
登録した件数分　連続でメール送信できるものになります。
以下画像　左が設定内容　右が差し込み後のメールになります。

２）エクセル　セル登録

シート１　以下のように作成

シート２　は転送用データとして以下にように作成します

開始行、メールアドレスＴｏ、ＣＣ、ＢＣＣ　・・・　は数値のみを入力したいので、　ここの入力規制します。
まず、入力制限したいセルを選択し
メニュー　データ　データの入力規制　を選択します。

ここで　整数　最小値　０　　最大値　９９　でＯＫ

メール文を入力できるように　テキストボックスを登録します。
メニュー　挿入　テキストボックスをクリック　横書きテキストボックス描画を選択し　画面の適当な位置に配置してください。

テストメール送信ボタンの下に　ワーク用も追加します。
計２つ作成し　TextBox1   TextBoxwk  の名称で登録します。

名称はメニュー　表示　数式バーにチェックすると　枠が追加されますので
ここに入力し　Enterキーを押します、Enterキーを押さないと確定しません

３）ＶＢＡ作成の準備

まず、開発のメニューがない場合　追加しておきます。

メニュー　ファイル　オプションを開き
リボンのユーザー設定を選択　ここの開発にチェックし　ＯＫ

ボタンを３つ追加します。
メニュー　開発　挿入から　ボタンを選択し適当な位置に配置します。
名称を　ボタン１　ボタン２　ボタン３　とします。　

ＶＢＡエディタを開きます。　開発のVisualBasicをクリック

開いたＶＢＡエディタの画面が開きます。
アウトルックを使用できるように参照設定します。
メニュー　ツール　参照設定をクリック

ここからMicrosoft Office 16.0 Object Library　にチェックを入れてＯＫ
これでアウトルックが使用できるようになります

ここから　ボタンをクリックすると　差し込み後　テストメールアドレスにメール転送するＶＢＡを作成してみます。
VBAは、「Visual Basic for Applications」の略語でエクセルをＶＢで拡張できるようになります。
プロジェクト　のMicrosoft Excel Objects の右クリックの標準モジュールを選択します。新規に画面が作成されますのでここに入力します。
　マクロで組むのは、手入力などの操作を自動にするには便利ですが、今回のメール転送はＶＢＡで作るしか方法はないかもしれません。

https://amzn.to/4aTwV2s

４）プログラム作成

テストメールアドレスにメール（ボタン３）にＰＧ
ws1 をSheet1
ws2をSheet2

開始行　シート１のＦ５を　Intで整数に変換し　０でないかチェック
StaRow = Int(ws1.Range("F5").Value)

テストメールアドレスは空白をチェック

添付ファイル
シート１のＦ９の登録が０でないかチェック
シート２（行NO、列NO)  開始行、Ｆ９の値をチェック
　test.pdf　なら、起動時のPASS＋test.pdf　に変更
　　Thisworkbook.pass が起動時のPASSになります

    Dim ws1 As Worksheet
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Dim ws2 As Worksheet
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Dim StaRow As Integer                       '開始行
    Dim oldText As String                       '元文字
    Dim newText As String                       '差し込み文字
    Dim TFile As String                         '添付ファイル


    '開始行
    StaRow = Int(ws1.Range("F5").Value)
    If StaRow = 0 Then
        MsgBox ("開始行が０です")
        Exit Sub
    End If
    
    'テストメールアドレス
    If ws1.Range("E19").Value = "" Then
        MsgBox ("テストメールアドレスが未入力です")
        Exit Sub
    End If
    
    '添付ファイル
    If Int(ws1.Range("F9").Value) <> 0 Then
        TFile = ws2.Cells(StaRow, ws1.Range("F9").Value).Value
        If TFile <> "" Then
            If InStr(TFile, "\") = 0 And InStr(TFile, ":") = 0 Then
                TFile = ThisWorkbook.Path & "\" & TFile
            End If
            
        End If
    End If

　
TextBox1をTextBoxwk に保存します。
これは、差し込みするため元の文章を残して置くためです。
TextBoxwkで文字置換処理します。
元文字　シート１のＥ１１の文字
　　oldText = ws1.Range("E11").Value
新文字　シート２の行、列で登録した文字
　　newText = ws2.Cells(StaRow, ws1.Range("F11").Value).Value
Replace　関数で　文字置換を実行します。

    'テキストボックスをワークにコピー
    ws1.TextBoxes("TextBoxwk").Text = ws1.TextBoxes("TextBox1").Text
    
    '差し込み文字1
    If Int(ws1.Range("F11").Value) <> 0 And ws1.Range("E11").Value <> "" Then
        oldText = ""
        newText = ""
        oldText = ws1.Range("E11").Value
        newText = ws2.Cells(StaRow, ws1.Range("F11").Value).Value
        ws1.TextBoxes("TextBoxwk").Text = Replace(ws1.TextBoxes("TextBoxwk").Text, oldText, newText)
    End If

メール転送
objMailItemを作成し
.To　　　メールアドレス
.subject　タイトル
.Body　　本文
.Attachments.Add　添付ファイル

.Display 　　　これで、メール画面が開きます。
.send 　　　　この場合　直接メール送信します。

    Dim objOutlook As Object
    Set objOutlook = CreateObject("Outlook.Application")    '外部ライブラリからOutlookを操作するオブジェクト作成
    Dim objMailItem As Object
    Set objMailItem = objOutlook.CreateItem(0)              'MailItemオブジェクト作成（末尾の(0)でMailItemオブジェクトを指定）
    
    With objMailItem
        .To = ws1.Range("E19").Value            'メールアドレス
        
        .Subject = ws1.Range("B3").Value        'タイトル
        .Body = ws1.TextBoxes("TextBoxwk").Text '本文
        If TFile <> "" Then
            If Dir(TFile) <> "" Then
                .Attachments.Add (TFile)        'ファイルを添付
            End If
            
        End If
        .Display                                ' メールを表示
        
    End With
    
    Set objOutlook = Nothing
    Set objMailItem = Nothing

以下　以下（有料ダウンロードのエクセル）　実行画面になります。

この内容で　メール転送できるソフトは作成できますが
このサンプル　エクセルファイルをダウンロードできるようにしています。
よければ、ダウンロードしてみてください。

以下から、ファイルをダウンロードできる画面が開きますので
クリックしてダウンロードしてください。
ダウンロードファイル（Mail_XL100）を開きフォルダごと、ディスクトップにでも保存してください。
Mail_XL.xlsm　がエクセルファイルになります。ダブルクリックで実行してください。
ドキュメントを開くとき、またはマクロを実行しようとしたときにセキュリティ警告が表示される場合は、信頼できるドキュメントにしてマクロを有効にしてください。　アップロード前にウィルスチェックしています。