VBAで複数Outlookメールを個別作成し一斉送信

Question

実現したいこと

Excel VBAを用いて、同じ文面のメールをリスト化された複数のアドレスと宛名を取得し送信したいです。
メール本文の中の、会社名や宛名を個別に置き換えたいです。
※ネットで拾ったコードを使わせてもらっています

発生している問題・分からないこと

マクロを実行すると、
「実行時エラー'62': ファイルにこれ以上データがありません。」
というエラー出て、一件しかメールを送信できません。

エラーメッセージ

実行時エラー'62': ファイルにこれ以上データがありません。

該当のソースコード

'プログラム0｜変数宣言の指定
Option Explicit
 
'プログラム1｜プログラム開始
Sub SendMails()
 
    'プログラム2｜変数設定
    Dim mailaddress As String
    Dim subject As String, mailbody As String
    Dim username As String, tsuchi As String
    Dim ws As Worksheet
    Dim cmax As Long
    Dim i As Long
    Dim txtfile As String, txtpath As String, attachedfile As String
    Dim txt As TextStream
    
    'プログラム3｜FileSystemObjectの設定
    Dim fs As Scripting.FileSystemObject
    Set fs = New Scripting.FileSystemObject
      
    'プログラム4｜テキストファイルの情報の取得
    txtfile = "【パソコンスキルの教科書】登録ありがとうございます.txt"
    txtpath = ThisWorkbook.Path & "\" & txtfile
    Set txt = fs.OpenTextFile(Filename:=txtpath, IOMode:=ForReading)
      
    'プログラム5｜メール件名の取得
    subject = Split(txtfile, ".")(0)
      
    'プログラム6｜添付ファイルを取得
    attachedfile = ThisWorkbook.Path & "\添付ファイル.jpg"
      
    'プログラム7｜ワークシート設定
    Set ws = Worksheets("メールリスト")
 
    'プログラム8｜各シートの記載情報を取得
    cmax = ws.Range("A65536").End(xlUp).Row
              
    'プログラム9｜Outlookメール送信用の変数設定
    Dim OutlookObj As outlook.Application
    Dim myMail As outlook.MailItem
    Set OutlookObj = CreateObject("Outlook.Application")
 
    'プログラム10｜シート「メールリスト」の情報を取得
    For i = 2 To cmax
        
        'プログラム11｜F列のON/OFFでメール通知設定を決定
        tsuchi = ws.Range("E" & i).Value
        If tsuchi = "ON" Then
        
            'プログラム12｜メール本文とメールアドレスを取得
            username = ws.Range("C" & i).Value
            mailbody = Replace(txt.ReadAll, "{名前}", username)
            mailaddress = ws.Range("D" & i).Value
            
            'プログラム13｜Outlookメールを作成
            Set myMail = OutlookObj.CreateItem(olMailItem)
            
            'プログラム14｜メール内容を設定
            myMail.BodyFormat = 3
            myMail.To = mailaddress
            myMail.CC = "[e-mail]"
            myMail.subject = subject
            myMail.Body = mailbody
    
            'プログラム15｜添付ファイルがあればメールに添付
            If attachedfile <> "" Then
                myMail.Attachments.Add (attachedfile)
            End If
            
            'プログラム16｜メール送信
            myMail.Display 'メール表示(ここでは誤送信を防ぐために表示だけにして､メール送信はしない)
            myMail.Send 'ここをコメントアウトすることでメール送信しないことも可能
            ws.Range("F" & i).Value = "送信完了：" & Now()
            
            'プログラム17｜オブジェクト解放
            Set myMail = Nothing
        End If
    Next
    Set OutlookObj = Nothing
 
'プログラム18｜プログラム終了
End Sub

試したこと・調べたこと

• teratailやGoogle等で検索した
• ソースコードを自分なりに変更した
• 知人に聞いた
• その他

上記の詳細・結果

teratailで同様の質問を見つけましたが、回答を見てもどのように修正すればいいかわからず、再度質問を上げさせていただいています。

補足

https://teratail.com/questions/370887（過去の同様のご質問）

Comments

[yambejp]

一昔前流行ったメリッサウィルスを思い出します。
OUTLOOKをVBAで送信するのはいやな記憶しかないですよね。
エクセルからどうしてもおくらないといけないんでしょうか？

[meg_]

> ※ネットで拾ったコードを使わせてもらっています
引用元を書くべきではないでしょうか。

Answer 1

実行時エラー'62': ファイルにこれ以上データがありません。

2 回以上のループ処理が発生する For 文の中で ReadAll メソッドを呼び出しているのが原因です。

Dim txt As TextStream

Set txt = fs.OpenTextFile(Filename:=txtpath, IOMode:=ForReading)

TextStream オブジェクトの Read メソッド、ReadLine メソッド、および ReadAll メソッドは、
呼び出されるごとに「そのメソッドによって読み込まれた文字列の長さ」だけファイルポインターを進めます。

For i = 2 To cmax

mailbody = Replace(txt.ReadAll, "{名前}", username)

つまり 1 回目のループで ReadAll メソッドが呼び出された時点で、そのテキストファイル内の全ての文字列を読み込まれたのと同時にファイルポインターがファイルの末尾に達している（ AtEndOfStream プロパティが True になっている）ため、2 回目のループで再度 ReadAll メソッドを呼び出そうにも「これ以上読み込めるデータはない」ので件の実行時エラーが返されることになります。

修正案

• OpenTextFile メソッドを呼び出した直後に ReadAll メソッドを 1 度だけ呼び出し、その戻り値を任意の String 型の変数に代入する。

Set txt = fs.OpenTextFile(Filename:=txtpath, IOMode:=ForReading)

Dim BodyTemplate As String
BodyTemplate = txt.ReadAll

• 上記の変数の値に含まれる "{名前}" を変数usernameの値に置換した結果を変数mailbodyに代入する処理を For ブロック内に記述する。

mailbody = Replace(BodyTemplate, "{名前}", username)

Comments

[kto]

ありがとうございます！
「ファイルポインターがファイルの末尾に達している（ AtEndOfStream プロパティが True になっている）ため、2 回目のループで再度 ReadAll メソッドを呼び出そうにも「これ以上読み込めるデータはない」
→ここが理解できていなかったので、丁寧に教えていただき非常に助かりました。