質問
2019年10月30日水曜日 7:22
いつもお世話になっております。VBAを使用してExcel表を参照しながら、
Outlookで複数の宛先に一括送信するマクロを作ってみました。
Outlookのライブラリを参照し、同一のBook内にある「アドレス帳」というシートを見ながら
「テンプレート」というシートをひな型にして送信するものです。
1件目は正常に送信できるのですが、2件目を送信するときに、
objMail.Send
という行で、「Outlookで認識できない名前があります」というエラー(-2147467259)が出て止まってしまいます。
objMail.Display と置き換えてみると、正常に送信したい状況で、Outlookのメッセージ送信画面が起動します。
添付ファイル関係のオブジェクトを参照する行を外してみたのですが、結果は同じなのでこれが原因でもないようです。
さっぱり判らず困っています。アドバイス頂けたら幸いです。
OS:Windows10(1903) Outlook2016
ソースは下記の通りです。
Sub SendEmail()
Dim objOutlook As Outlook.Application
Dim objMail As Outlook.MailItem
Dim objAttach As Outlook.Attachments
Dim wsTemp As Worksheet
Dim wsMail As Worksheet
Dim contents As Variant
Dim i As Integer
Set objOutlook = CreateObject("Outlook.Application")
Set wsTemp = ThisWorkbook.Sheets("テンプレート")
Set wsMail = ThisWorkbook.Sheets("アドレス帳")
On Error GoTo err:
For i = 1 To 999
With wsMail
Set objMail = objOutlook.CreateItem(olMailItem)
If .Cells(i, 1).Value = "" Then Exit For 'アドレス帳が終わるまで繰り返し
objMail.To = .Cells(i, 2).Value 'メール宛先
objMail.subject = wsTemp.Range("B1").Value 'メール件名
objMail.BodyFormat = olFormatPlain 'メールの形式
objMail.Body = Replace(Replace(Replace(wsTemp.Range("B2").Value, "$1", .Cells(i, 1).Value), "$2", .Cells(i, 2).Value), "$3", .Cells(i, 3).Value)
Set objAttach = objMail.Attachments
If wsTemp.Range("B3").Value <> "" Then
objAttach.Add wsTemp.Range("B3").Value
End If
If wsTemp.Range("B4").Value <> "" Then
objAttach.Add wsTemp.Range("B4").Value
End If
If wsTemp.Range("B5").Value <> "" Then
objAttach.Add wsTemp.Range("B5").Value
End If
' objMail.Display // こちらではエラーが出ない
objMail.Send
Set objAttach = Nothing
Set objMail = Nothing
End With
Next i
Set objOutlook = Nothing
MsgBox "送信完了"
Exit Sub
err:
MsgBox err.Description & "(" & Str(err.Number) & ")"
End Sub
すべての返信 (2)
2021年1月27日水曜日 1:29
問題はここですね。
objMail.To = .Cells(i, 2).Value
下記のように書いてみてください。
Dim tmp As Variant
' Add the To recipient(s) to the message.
tmp = Split(wsMail.Cells(i, 2).Value,";")
For i = 0 To UBound(tmp)
If(tmp(i) <> "") then
Set objOutlookRecip = .Recipients.Add(tmp(i))
objOutlookRecip.Type = olTo
End If
Next i
CC,BCCも同じように書かないと認識しないようです。
2021年2月8日月曜日 12:47
wsMail.Cells(2，2)にどのようなアドレスが記入されているのかを確認されてどうだったのか、分かりませんが、小生の場合、メールアドレスの半角の｢@｣が全角の｢@｣となっていてエラーが出ました。記入した際に間違えたようです。ちょっと見た目が;ているので、分かりません。
そんな単純な原因ではないですかねぇ?
もしもそうであれば、正規表現でメールアドレスの文字列をチェックするステップを挿入するとか、strConv関数で端から半角に変換してしまうことによって、エラーを回避することができるのでは？