[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『エクセルからメールを送信する』（中也さん）
こんにちは。
エクセルからOutlookメールの送信マクロを作ったのですが、こちらの不備が解消されなのでご教授お願いできないでしょうか。
・メールのTO宛先が入力されない。
・メール本文の途中にエクセルの「A8セルから最終行まで」を載せたいのに最終行しか載らない。
「メールリスト」シートの情報
A列 B列 D列 C列
1行目・・・Ｎｏ． 名前 アドレス 状況（DONE）
2行目・・・1 中也 xxx@.com
3行目・・・2 太朗 aaa@.com
「メール設定」シートの情報
2行目（メールの件名）・・・リマインドメール
3行目（本文1）・・・サポート切れはこちら（aka）
4行目（本文2）・・・サポート切れ1年以内（kiro）
5行目（本文3）・・・以上です。
7行目・・・■期限切れ ■一年後
8行目・・・A８から下に期限切れのリスト、B８から下に一年後リストがあります。
【完成したメールの本文】
サポート切れはこちら（aka）
★A列の最終行の値だけしか載らない★
サポート切れ1年以内（kiro）
★B列の最終行の値だけしか載らない★
以上です。
Sub メールの送信()
'プログラム2｜変数設定
Dim i As Long
Dim status As String, mailaddress As String, ccaddre
'プログラム3｜各シートのデータ取得
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("メールリスト")
Set ws2 = Worksheets("メール設定")
aka = ws2.Range("A8").End(xlDown).Value
kiro = ws2.Range("B8").End(xlDown).Value
'プログラム4｜最終行を取得
Dim cmax As Long
cmax = ws1.Range("A65536").End(xlUp).Row
'プログラム5｜セル範囲を取得
Dim myrange1 As Variant
myrange1 = ws1.Range("A2:D" & cmax)
'プログラム6｜「メール設定」シートのデータ取得
Dim subject As String, mailbody As String
subject = ws2.Range("B2").Value '件名
mailbody = ws2.Range("B3").Value '本文
'プログラム7｜Outlookを起動
Dim OutlookObj As Outlook.Application
Set OutlookObj = CreateObject("Outlook.Application")
Dim myMail As Outlook.MailItem
'プログラム8｜「メールリスト」シートのデータを各行ごとに処理
For i = LBound(myrange1) To UBound(myrange1)
'プログラム9｜D列が「DONE」でないならば処理を実行
status = myrange1(i, 4)
If Not status = "DONE" Then
'プログラム10｜メールアドレスを取得してメール情報を書き換える
mailaddress = myrange1(i, 4)
'プログラム11｜Outlookメールを作成
Set myMail = OutlookObj.CreateItem(olMailItem)
'プログラム12｜メール内容を作成
myMail.BodyFormat = 3
myMail.To = mailaddress
myMail.subject = subject
myMail.Body = mailbody & vbCrLf & aka & vbCrLf & ws2.Range("B4").Value & vbCrLf & kiro & vbCrLf & ws2.Range("B5").Value
'プログラム14｜メール送信
myMail.Display
'Application.Wait Now() + TimeValue("00:00:03")
'myMail.Send
'プログラム15｜オブジェクト解放
Set myMail = Nothing
End If
Next
Set OutlookObj = Nothing
'プログラム16｜プログラム終了
End Sub
メールの宛先が入力されないのは、プログラム6、8、9の何かが間違っている。
メール本文にリストの最終行しか表示されないのはプログラム3が間違っているのだと思います。
長くて申し訳ございません。
宜しくお願い致します。
＜ 使用 Excel：Office365、使用 OS：Windows10 ＞
■１
＞メールのTO宛先が入力されない。
myrange1 = ws1.Range("A2:D" & cmax)
For i = LBound(myrange1) To UBound(myrange1)
mailaddress = myrange1(i, 4)
myMail.To = mailaddress
↓
For i =2 To ws1.Cells(Rows.Count,"D").End(xlup).Row
MyMail.To = ws1.Cells(i,"D").Value
＞メールの宛先が入力されないのは、プログラム6、8、9の何かが間違っている。
よく分かりませんが、素直に該当セルを直接見たら如何ですか？
■２
＞メール本文の途中にエクセルの「A8セルから最終行まで」を載せたいのに最終行しか載らない。
myMail.Body = mailbody & vbCrLf _
& aka & vbCrLf _
& ws2.Range("B4").Value & vbCrLf _
& kiro & vbCrLf _
& ws2.Range("B5").Value
↓変数を展開するとこうなる↓
myMail.Body = Worksheets("メール設定").Range("B3").Value & vbCrLf _
& Worksheets("メール設定").Range("A8").End(xlDown).Value & vbCrLf _ ★
& Worksheets("メール設定").Range("B4").Value & vbCrLf _
& Worksheets("メール設定").Range("B8").End(xlDown).Value & vbCrLf _
& Worksheets("メール設定").Range("B5").Value
すなわち、そもそも★の部分ではA8セルから下方向に見たときの最終セルのみ指定しています。
＞＞メール本文にリストの最終行しか表示されないのはプログラム3が間違っているのだと思います。
したがって、気にするべきはそこではないです。
例えば↓のようにちゃんと「A8セルから最終行まで」を取得しないとダメです。
Sub 研究用01()
Dim i As Long
Dim buf As String
With Worksheets("メール設定")
For i = 8 To .Cells(.Rows.Count, "A").End(xlUp).Row
buf = buf & .Cells(i, "A").Value & vbLf
Next i
buf = Left(buf, Len(buf) - 1)
MsgBox buf
End With
End Sub
'--------------------------------------------------------------------------------
Sub 研究用02()
Dim i As Long
Dim buf As String
With Worksheets("メール設定")
i = .Cells(.Rows.Count, "A").End(xlUp).Row
Select Case True
Case i < 8
MsgBox "データ無し"
Exit Sub
Case i = 8
buf = .Cells(i, "A").Value
Case Else
buf = Join(WorksheetFunction.Transpose(.Range("A8:A" & i).Value), vbLf)
End Select
End With
MsgBox buf
End Sub
（もこな２） 2021/12/15(水) 18:27
宛先は素直に直接見ることにしました。
メール本文の研究用1の方ですが、A列の最終行が1番最初にも表示されて2回表示されました。
こちらはどのコードの部分が1回多く表示させているのでしょうか？
【最終行がA11だとこのように表示されました】
A11A8
A9
A10
A11
お手数お掛けしますが、宜しくお願いします。
（中也さん） 2021/12/16(木) 17:37
■３
「■１」の補足になりますが、提示のあった表の【列】標記が正しいとすれば↓ですよね。
【メールリスト】シート
___A__ __B_ ___【C】___ __【D】__
1 Ｎｏ． 名前 状況（DONE） アドレス
2 1 中也 xxx@.com
3 2 太朗 aaa@.com
そうなると「myrange1」には↓のような【二次元配列】が格納されているわけですよね。
【1】 【2】 【3】 【4】
【1】 1 "中也" "" "xxx@.com"
【2】 2 "太朗" "" "aaa@.com"
mailaddress = myrange1(i, 4) myMail.To = mailaddress
その上で↑であれば、たとえば「i」が1の場合
mailaddress = myrange1(i, 4) → mailaddress = "xxx@.com" myMail.To = mailaddress → myMail.To = "xxx@.com"
ですから「メールのTO宛先が入力されない。」といったことにはならないとおもいます。
一方で、提示のあった表の【列】標記が誤っていて、提示の並び順が正しいとすれば↓ですよね。
【メールリスト】シート
___A__ __B_ ___【C】___ ___【D】__
1 Ｎｏ． 名前 アドレス 状況（DONE）
2 1 中也 xxx@.com
3 2 太朗 aaa@.com
こちらの場合は「myrange1」が↓になるわけですから
【1】 【2】 【3】 【4】
【1】 1 "中也" "xxx@.com" ""
【2】 2 "太朗" "aaa@.com" ""
myMail.To = ""
↑となるのは正しい動作ですよね。
にもかかわらず↓のようにしている（同じ4要素目？を見ている）ので、対象の【列】が間違いではないかと疑っています。
status = myrange1(i, 4) If Not status = "DONE" Then
mailaddress = myrange1(i, 4) myMail.To = mailaddress
配列に入れて処理したほうが有利なケースもあるでしょうし、それぞれの好みもあるので否定はしませんが、エクセルには【セル】という強力な武器があるのですから、そちらを最大限活用したほうが、デバッグしやすいのではないか？というのが「■１」の趣旨でした。
配列に入れることを否定するような書きぶりになってしまったので少々補足させていただきます。
■４
＞メールの宛先が入力されないのは、プログラム6、8、9の何かが間違っている。
＞メール本文にリストの最終行しか表示されないのはプログラム3が間違っているのだと思います。
なぜ、そのようにおもったのでしょうか？
いずれも【ステップ実行】して追っていけば、原因はそこではないことが容易にわかるかと思いますので、あらためて自己検証してみてください。
※ステップ実行という言葉を聞いたことがなければ↓を読んでみてください。
【ステップ実行】 https://www.239-programing.com/excel-vba/basic/basic023.html http://plus1excel.web.fc2.com/learning/l301/t405.html
【ブレークポイント】 https://www.239-programing.com/excel-vba/basic/basic022.html https://www.tipsfound.com/vba/01010
また、以下も知っておいて損は無いと思います。
【イミディエイトウィンドウ】 https://www.239-programing.com/excel-vba/basic/basic024.html https://excel-ubara.com/excelvba1/EXCELVBA486.html
【ローカルウィンドウ】 https://excel-ubara.com/excelvba4/EXCEL266.html http://excelvba.pc-users.net/fol8/8_2.html
■５
＞メール本文の研究用1の方ですが、A列の最終行が1番最初にも表示されて2回表示されました。
＞こちらはどのコードの部分が1回多く表示させているのでしょうか？
ちょっと状況がわかりませんが、【ステップ実行】して確認のうえ【どのセルを順番にみていたか】結果をおしえてください。
■６
＞宛先は素直に直接見ることにしました。
して、方法（どこをどう直せばよいか）はわかっているのですか？
↓でも感じたことですが、言われたことをオウム返しをしているだけで理解できている感じがしないのですが・・・・
[[20211209152742]] 『セルの色毎に一覧に出力する』（中也さん）
■７
最初に提示されたものを見ると、いくつかの【変数】が宣言されていません。
まずは↓を読んで、変数の宣言が強制されるように設定を変えることをお勧めします。
http://officetanaka.net/excel/vba/beginner/06.htm
■８
ちょっと気になったのでお伺いしますが、アーリーバインディングとレイトバインディングどちらでいかれるつもりですか？
Dim OutlookObj As Outlook.Application
Set OutlookObj = CreateObject("Outlook.Application")
Set myMail = OutlookObj.CreateItem(olMailItem)
↑のようになってるので少々気になりました。
（もこな２） 2021/12/16(木) 20:30
問題ないのであれば、現状のようにループの外側で件名にあたる部分や本文にあたる部分を取得すればよいですが、そうでない場合はループ中に取得しないとダメですよね。
（もこな２ ） 2021/12/17(金) 09:26
■3
メールリストの「状況（DONE）」を無くしました。
不要な宛先はシートから削除して送信させない。
■4
ウィンドウ枠の使い方参照させて頂きました。
■5
最初に記載したこちらを消してないのが原因でした。（最終行だけ表示するやつ）
aka = ws2.Range("A8").End(xlDown).Value
kiro = ws2.Range("B8").End(xlDown).Value
あと、Nextの位置が悪く、「「メール設定」シートのリストを取得」に戻り、次の宛先分を作成する時に前の「akaとkiro」のリストの続きに追記していたのが問題でした。
■6
宛先を個人宛ではなく、「；」で全員入るように変更しました。
Join関数の方が見やすそうでしたが、「MyMail.To = ws1.Cells(i,"D").Value」の改良の仕方が分からなかったので、&で連結しました。
wkaddress = wkaddress & ws1.Cells(i, "C").Value & " " & ";"
連結したのですが、たまに「表示する名前が多すぎます。名前の文字を追加してもう一度やり直してください」と出るようになりました。。
■7
変数宣言の強制にチェックし、足りない宣言を追加しました。
■8
レイトバインディングの方が分かり易いのですが、実行するまでリスクが大きいそうなのでアーリーバインディングでできればいきたいなと。。。
■9
人によって変更する箇所は予定していないので固定で大丈夫です。
↓↓この時のリスト作成マクロですが、作成前に8行目以降をDeleteするのを忘れていたので最初に初期化を追記しておきます。
[[20211209152742]] 『セルの色毎に一覧に出力する』（中也さん）
■追加なのですが、メールを送信する時にOutlookの誤送信防止ツールが働き、「メール送信最終確認」のポップが表示されます。
ネットにはポップの非表示ばかり挙がっていたのですが、「送信」ボタンを自動で押すことは可能でしょうか？（送信とキャンセルの2択でした）
↓↓こちらが修正後のコードです。
Sub メールの送信()
'プログラム1｜変数設定
Dim i As Long, j As Long, k As Long
Dim status As String, mailaddress As String
'プログラム2｜各シートのデータ取得
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("メールリスト")
Set ws2 = Worksheets("メール設定")
'プログラム3｜最終行を取得
Dim cmax As Long
cmax = ws1.Range("A65536").End(xlUp).Row
'プログラム4｜「メール設定」シートのデータ取得
Dim subject As String, mailbody As String
subject = ws2.Range("B2").Value '件名
mailbody = ws2.Range("B3").Value '本文
'プログラム5｜Outlookを起動
Dim OutlookObj As Outlook.Application
Set OutlookObj = CreateObject("Outlook.Application")
Dim myMail As Outlook.MailItem
'プログラム6｜メールアドレスを取得
Dim wkaddress As String
For i = 2 To ws1.Cells(Rows.Count, "C").End(xlUp).Row
wkaddress = wkaddress & ws1.Cells(i, "C").Value & " " & ";"
Next
'プログラム7｜「メール設定」シートのリストを取得
Dim aka As String, kiro As String
With Worksheets("メール設定")
For j = 8 To .Cells(.Rows.Count, "A").End(xlUp).Row
aka = aka & .Cells(j, "A").Value & vbLf
Next j
aka = Left(aka, Len(aka) - 1)
End With
With Worksheets("メール設定")
For k = 8 To .Cells(.Rows.Count, "B").End(xlUp).Row
kiro = kiro & .Cells(k, "B").Value & vbLf
Next k
kiro = Left(kiro, Len(kiro) - 1)
End With
'プログラム8｜Outlookメールを作成
Set myMail = OutlookObj.CreateItem(olMailItem)
'プログラム9｜メール内容を作成
myMail.BodyFormat = 3
myMail.To = wkaddress
myMail.subject = subject
myMail.Body = mailbody & vbCrLf _
& aka & vbCrLf _
& ws2.Range("B4").Value & vbCrLf _
& kiro & vbCrLf _
& ws2.Range("B5").Value
'プログラム10｜メール送信
myMail.Display
Application.Wait Now() + TimeValue("00:00:03")
myMail.Send '最終確認大矢ログが出現～考える～
'プログラム11｜オブジェクト解放
Set myMail = Nothing
Set OutlookObj = Nothing
'プログラム12｜プログラム終了
MsgBox "送信完了"
End Sub
（中也さん） 2021/12/17(金) 16:46
■11
＞ウィンドウ枠の使い方参照させて頂きました。
仰ってることがよくわかりません。
【ステップ実行】についてお話したつもりですが・・・・
■12
＞最初に記載したこちらを消してないのが原因でした。（最終行だけ表示するやつ）
わかりました。解決したなら深堀しません。（仰ってることが私には理解できないので）
■13
＞宛先を個人宛ではなく、「；」で全員入るように変更しました。
それでよかったのですか？まぁ困らないなら好きにしてください。
なお、「" "」は要らないと思います。
■14
＞変数宣言の強制にチェックし、足りない宣言を追加しました。
チェックするだけではダメなんですが・・・・まぁ見る限り全部宣言されているようなのでいいですかね。
■15
＞アーリーバインディングでできればいきたいなと。。。
わかりました。
■16
＞人によって変更する箇所は予定していないので固定で大丈夫です。
わかりました。
■17
＞追加なのですが～～
ちょっとそのような挙動は見たことがないのでわかりません。
ただ、いきなり「Send」してよいなら「Display」する必要はないのでは？
■18
ということを踏まえて、私が整理するならこんな感じですかね（■10と■13は考慮してません）
ステップ実行して研究の上、改造の参考にしてみてください。
Sub メールの送信の整理()
Dim i As Long
Dim 本文 As String, aka As String, kiro As String
Dim OutlookObj As Outlook.Application
Dim myMail As Object
Set OutlookObj = New Outlook.Application
'メール本文を取得する
With Worksheets("メール設定")
For i = 8 To .Cells(.Rows.Count, "A").End(xlUp).Row Step 1
aka = aka & .Cells(i, "A").Value & vbLf
Next i
For i = 8 To .Cells(.Rows.Count, "B").End(xlUp).Row Step 1
kiro = kiro & .Cells(i, "B").Value & vbLf
Next i
本文 = .Range("B3").Value & vbCrLf & aka & .Range("B4").Value & vbCrLf & kiro & .Range("B5").Value
End With
'メールを生成する
With Worksheets("メールリスト")
For i = 2 To .Cells(.Rows.Count, "C").End(xlUp).Row
If Cells(i, "D").Value <> "DONE" Then
Set myMail = OutlookObj.CreateItem(olMailItem)
myMail.BodyFormat = olFormatRichText
myMail.To = .Cells(i, "C").Value
myMail.subject = Worksheets("メール設定").Range("B2").Value
myMail.Body = 本文
myMail.Display '送信せず表示するだけ
End If
Next i
End With
MsgBox "内容を確認して送信してください"
End Sub
（もこな２ ） 2021/12/17(金) 22:11
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.