次の方法で共有


Outlookでメール送信すると2件目から「Outlookで認識できない名前があります」と出る

質問

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関数で端から半角に変換してしまうことによって、エラーを回避することができるのでは?