前提・実現したいこと
エクセルリストシート(Teilnehmerliste_eng)上の各メールアドレス宛に各々に作成したpdfを送信するシステムを作成しています。シート"MailTemplate"上にメールのテンプレートを記載しており、メール内容にはTeilnehmerliste_eng上の参加者名等をReplace関数にて挿入します。
自学しているもののマクロ初心者で、拙いコードで申し訳ないのですが、説明に不足がございましたら訂正、追記させていただきますので、どうか皆様のアドバイスをいただければ幸いです。
発生している問題・エラーメッセージ
pdf送信コードを作成し、作動させたところ、Run-time error"-2147024894 (80070002)" Cannot find this fileが表示されますが、pdfは問題なく送信されました。試しにOn Error GoTo ErrorHandlerで強制終了させたところ、エラー表示なくpdfそうしんできるようになりました。 しかしReplace関数を挿入したところ、どの文字も置換されないままテンプレート文が送信されてしまいます。
該当のソースコード
Sub sendpdf() Dim oApp Dim Wm_ITEM Dim Wm_TO Set oApp = GetObject(, "Outlook.Application") Dim folder As String Dim FileName As String Dim row As Long Dim shname As String Dim ListSheet As String '参加者リストTeilnehmerliste_engでは2行目から参加者情報が記載されているため、row=2としています。 row = 2 shname = "MailTemplate" ListSheet = "Teilnehmerliste_eng" On Error GoTo ErrorHandler Do Until row = ThisWorkbook.Sheets(ListSheet).Cells(Rows.Count, 1).End(xlUp).row 'open Outlook Set Wm_ITEM = oApp.CreateItem(0) Wm_TO = "" WS_OutLk = "" '参加者リストTeilnehmerliste_engでは3列目にメールアドレスが記載されているため、Cells(row,3)としています。メールテンプレートシートMailTemplateにはCells(1,2)に件名、Cells(2,2)にメールテンプレートが記載されています。 Wm_ITEM.To = ThisWorkbook.Sheets(ListSheet).Cells(row, 3) Wm_ITEM.Subject = ThisWorkbook.Sheets(shname).Cells(1, 2) Wm_ITEM.Body = ThisWorkbook.Sheets(shname).Cells(2, 2) 'メールテンプレートMailTemplate Cells(2,2)上の文字Attendantに参加者リスト上Cells(row, 2)の参加者名、<Title>に参加者リストCells(2,4)のタイトル、<Date>に参加者リストCells(2,5)の日付、<Formslink>に参加者リストCells(3,9)のリンクを挿入(置換)します。 Wm_ITEM.Body = Replace(ThisWorkbook.Sheets(shname).Cells(2, 2), "Attendant", ThisWorkbook.Sheets(ListSheet).Cells(row, 2)) Wm_ITEM.Body = Replace(ThisWorkbook.Sheets(shname).Cells(2, 2), "<Title>", ThisWorkbook.Sheets(ListSheet).Cells(2,4)) Wm_ITEM.Body = Replace(ThisWorkbook.Sheets(shname).Cells(2, 2), "<Date>", ThisWorkbook.Sheets(ListSheet).Cells(2,5)) Wm_ITEM.Body = Replace(ThisWorkbook.Sheets(shname).Cells(2, 2), " <Formslink>", ThisWorkbook.Sheets(ListSheet).Cells(3,9)) 'attach certificate FileName = ThisWorkbook.Path & "_" & ThisWorkbook.Worksheets(ListSheet).Cells(row, 2).Value & _ "_" & Format(Date, "yyyymmdd") & "_.pdf" Wm_ITEM.Attachments.Add FileName Wm_ITEM.display 'Draft mail & send Wm_ITEM.Save Wm_ITEM.Send row = row + 1 Loop MsgBox "Sent certificate" Exit Sub ErrorHandler: MsgBox "Sent certificate" End Sub
試したこと
On Errorを消してDebug Step Intoを試したところ、Run-time error"-2147024894 (80070002)" Cannot find this fileが表示されますが、pdfは問題なく送信されます。
補足情報(FW/ツールのバージョンなど)
アドバイスいただきたい優先順位として①Replace関数がうまくいかない原因をご教授いただければ幸いです。もし可能であれば、②On Errorを使用しなくても良い方法、③現在vba実行に時間がかかっているので、コードを短縮できる方法もアドバイス頂けると非常に有難いです。
回答1件
あなたの回答
tips
プレビュー