質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Outlook

Microsoft OutlookはMicrosoft Officeの一部として組み込まれている、のユーザー管理とメーラーの機能を持ち合わせたソフトウェアです。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

メール

メールは、コンピュータネットワークを利用し、 情報等を交換する手段のことです。

Q&A

解決済

1回答

4102閲覧

マクロ Outlook メールの一斉送信について

ponsuke0025

総合スコア1

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Outlook

Microsoft OutlookはMicrosoft Officeの一部として組み込まれている、のユーザー管理とメーラーの機能を持ち合わせたソフトウェアです。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

メール

メールは、コンピュータネットワークを利用し、 情報等を交換する手段のことです。

0グッド

0クリップ

投稿2020/06/02 12:19

前提・実現したいこと

①マクロを使ってアウトルックのメールの一斉送信を行いたいです。
②宛先ごとに本文の内容を一部変更したいです。
コードは下記のサイトを参考にしました。
https://moripro.net/vba-outlook-createmail/

発生している問題・エラーメッセージ

1つの「氏名」に対して、「使用日」や「金額」にあたる数字が複数ある場合、
どのようにコードを書いたら良いでしょうか。

Dim mBody As String 'メール本文 mBody = Cells(2, "J").Value '初期値を設定 mBody = Replace(mBody, "(氏名)", sName) mBody = Replace(mBody, "(使用日)", DayOfUse) mBody = Replace(mBody, "(金額)", price) mBody = mBody & vbCrLf & vbCrLf & sign '末尾に署名を付与

該当のソースコード

Enum col '1以降の数値を省略した場合は+1される 宛先 = 1 複写 氏名 使用日 金額 End Enum Sub Outlookメール一括作成() Dim OutlookObj As Outlook.Application 'Outlookオブジェクトの作成 Set OutlookObj = New Outlook.Application Dim r As Long For r = 2 To Cells(1, 1).End(xlDown).Row '対象人数分の処理を繰り返す Dim mailItemObj As Outlook.MailItem 'メールアイテムオブジェクト作成 Set mailItemObj = OutlookObj.CreateItem(olMailItem) Dim mailBody As String mailBody = CreateMailBody(r) 'メール本文作成 With mailItemObj 'メールアイテム作成 .To = Cells(r, col.宛先).Value 'Toを設定 .CC = Cells(r, col.複写).Value 'CCを設定 .Subject = Cells(1, "J").Value '件名を設定 .Body = mailBody '本文を設定 End With mailItemObj.Display '下書きを表示 '次のメールアイテムを作成するためいったん破棄 Set mailItemObj = Nothing Next r End Sub Function CreateMailBody(r As Long) As String ' 機能:Excelシート上の指定行番号のメール本文を作成する Dim sName As String, DayOfUse As String, price As Long sName = Cells(r, col.氏名).Value DayOfUse = Cells(r, col.使用日).Value price = Cells(r, col.金額).Value Dim sign As String '署名 sign = Cells(12, "J").Value Dim mBody As String 'メール本文 mBody = Cells(2, "J").Value '初期値を設定 mBody = Replace(mBody, "(氏名)", sName) mBody = Replace(mBody, "(使用日)", DayOfUse) mBody = Replace(mBody, "(金額)", price) mBody = mBody & vbCrLf & vbCrLf & sign '末尾に署名を付与 CreateMailBody = mBody End Function

試したこと

ワークシートの行を増やしてみましたがズレてしまいます。1つの「氏名」に対して複数「金額」や「使用日」が
ある場合もあれば、当該項目が1つのみの場合もある状況です。

補足情報(FW/ツールのバージョンなど)

マクロ初心者です。上記の方法をご存知でしたらご教示いただけますと幸いです。
よろしくお願いいたします。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答1

0

ベストアンサー

イメージ説明

こんな感じで

VBA

1Enum col '1以降の数値を省略した場合は+1される 2 宛先 = 1 3 複写 4 氏名 5 使用日 6 金額 7End Enum 8 9Sub Outlookメール一括作成() 10 11 Dim OutlookObj As Outlook.Application 'Outlookオブジェクトの作成 12 Set OutlookObj = New Outlook.Application 13 14 'リスト範囲 15 Dim rngFrom As Range, setRng As Range, trgRng As Range 16 Set rngFrom = ActiveSheet.Range("A1").CurrentRegion 'データー範囲 17 Set setRng = Intersect(rngFrom.SpecialCells(xlCellTypeConstants), rngFrom.Offset(1), rngFrom.Range("A:A")) '(データーのある行x1行下xA列)=送信メールのある行 18 19 '宛先のある行を配列に収める 20 Dim setRow 21 ReDim setRow(setRng.Count) 22 i = 0 23 For Each trgRng In setRng 24 setRow(i) = trgRng.Row 25 i = i + 1 26 Next 27 setRow(i) = Cells(1, 4).End(xlDown).Row + 1 '最後に票の下の行 28 29 'メール作成開始 30 Dim r As Long, nr As Long 31 For i = 0 To UBound(setRow) - 1 32 r = setRow(i) '対象開始行 33 nr = setRow(i + 1) '対象終了行 34 Dim mailItemObj As Outlook.MailItem 'メールアイテムオブジェクト作成 35 Set mailItemObj = OutlookObj.CreateItem(olMailItem) 36 37 Dim mailBody As String 38 mailBody = CreateMailBody(r, nr) 'メール本文作成 39 40 With mailItemObj 'メールアイテム作成 41 .To = Cells(r, col.宛先).Value 'Toを設定 42 .CC = Cells(r, col.複写).Value 'CCを設定 43 .Subject = Cells(1, "J").Value '件名を設定 44 .Body = mailBody '本文を設定 45 End With 46 47 mailItemObj.Display '下書きを表示 48 49 '次のメールアイテムを作成するためいったん破棄 50 Set mailItemObj = Nothing 51 52 Next 53 54End Sub 55 56Function CreateMailBody(r As Long, nr As Long) As String 57 58' 機能:Excelシート上のr行番目からnr-1行目までの明細のメール本文を作成する 59 60 Dim sName As String, DayOfUse As String, Price As String 61 sName = Cells(r, col.氏名).Value 62 For i = r To nr - 1 '桁を揃えて連結 63 DayOfUse = Format(Cells(i, col.使用日).Text, "yyyy/mm/dd") 64 Price = Right(" " & Format(Cells(i, col.金額).Value, "###,###,##0"), 14) 65 strData = strData & DayOfUse & Price & vbCrLf 66 Next 67 68 Dim sign As String '署名 69 sign = Cells(12, "J").Value 70 71 Dim mBody As String 'メール本文 72 mBody = Cells(2, "J").Value '初期値を設定 73 mBody = Replace(mBody, "(氏名)", sName) 74 mBody = Replace(mBody, "(DATA)", strData) 75 mBody = mBody & vbCrLf & vbCrLf & sign '末尾に署名を付与 76 CreateMailBody = mBody 77 78End Function 79

投稿2020/06/02 15:23

sinzou

総合スコア392

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

ponsuke0025

2020/06/03 01:03

新蔵さま 早速のご回答、ありがとうございます。早速試してみたいと思います。大変助かりました。 ありがとうござました!
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問