none
ExcelのVBAを利用してOutlookのメールを送信したい RRS feed

  • 質問

  • Excel2016のVBAで、Outlook2016のメールを一括送信するマクロを作成しようとしております。

    意図している動作は、

    1 「メール内容」シートの、タイトル・本文を、メールに貼り付ける。

    2 「送信先」の会社名等を、メールに貼り付ける。

    3 「送信先」の添付ファイルを、メールに添付する。

    4 メールは送信せず、保存する。

    5 「送信先」に記載の会社名等のすべてについて、上記1~5を繰り返す。

    で、以下のプログラムです。

    Sub SendEmail()

     
    Dim objOutlook As Outlook.Application
    Dim i
    Dim rowMax As Long
    Dim wsList As Worksheet
    Dim wsMail As Worksheet
    Dim objMail As Outlook.MailItem
     
    Set objOutlook = New Outlook.Application
    Set wsList = ThisWorkbook.Sheets("送信先")
    Set wsMail = ThisWorkbook.Sheets("メール内容")
     
    With wsList
     
        '送信先の件数
        rowMax = .Cells(Rows.Count, 1).End(xlUp).Row
     
        '送信先の件数分繰り返す
        For i = 2 To rowMax
            Set objMail = objOutlook.CreateItem(olMailItem)
            With wsMail
                .To = wsList.Cells(i, 4).Value       'メール宛先(To)
                .cc = wsList.Cells(i, 5).Value       'メール宛先(cc)
                .BCC = wsList.Cells(i, 6).Value      'メール宛先(BCC)
                .subject = .Range("B1").Value        'メール件名
                .BodyFormat = olFormatPlain          'メールの形式
                .Body = wsList.Cells(i, 1).Value & vbCrLf & _
                             wsList.Cells(i, 2).Value & " " & _
                             wsList.Cells(i, 3).Value & " 様" & vbCrLf & vbCrLf & _
                            mailItemObj.Range("B2").Value              'メール本文
                .attached = wsList.Cells(i, 7).Value     '添付ファイル1
                .attached = wsList.Cells(i, 8).Value     '添付ファイル2
                .attached = wsList.Cells(i, 9).Value     '添付ファイル3
                .Save '下書き保存
            End With
           
        Next i
       
        Set objOutlook = Nothing
        MsgBox "下書き保存しました。メールの内容を確認の上、送信してください。"
     
    End With

    End Sub

    ところが、VBAを実行すると、「メソッドまたはデータメンバーが見つかりません。」とのエラーメッセージが出ます。

    いくつかのホームページをあたったのですが、原因は分からずじまいです。

    自身はVBAについては初心者でありますが、ご教授のほど、ご協力をよろしくお願いします。

    2019年8月7日 0:51

回答

  • 魔界の仮面弁士 様、皆様


    お忙しいところ引き続き回答していただき、ありがとうございます

    無事、目的を達成することができました。
    なお、ccや添付ファイルが無いことも想定して、以下のとおり書き換えました。


    Option Explicit
    Sub SendEmail()
     
    Dim objOutlook As Outlook.Application
    Dim i As Long
    Dim rowMax As Long
    Dim wsList As Worksheet
    Dim wsMail As Worksheet
    Dim objMail As Outlook.MailItem
     
    Set objOutlook = New Outlook.Application
    Set wsList = ThisWorkbook.Sheets("送信先")
    Set wsMail = ThisWorkbook.Sheets("メール内容")
     
     
        '送信先の件数
        rowMax = wsList.Cells(wsList.Rows.Count, 1).End(xlUp).Row
     
        '送信先の件数分繰り返す
            For i = 3 To rowMax
            Set objMail = objOutlook.CreateItem(olMailItem)
                If Not (wsList.Cells(i, 4).Value) = 0 Then
                objMail.To = wsList.Cells(i, 4).Value       'メール宛先(To)。空白の場合はスキップ
                End If
                If Not (wsList.Cells(i, 5).Value) = 0 Then
                objMail.cc = wsList.Cells(i, 5).Value       'メール宛先(cc)。空白の場合はスキップ
                End If
                If Not (wsList.Cells(i, 6).Value) = 0 Then
                objMail.BCC = wsList.Cells(i, 6).Value      'メール宛先(BCC)。空白の場合はスキップ
                End If
                objMail.subject = wsMail.Range("B1").Value  'メール件名
                objMail.BodyFormat = olFormatPlain          'メールの形式
                objMail.Body = wsList.Cells(i, 1).Value & vbCrLf & _
                             wsList.Cells(i, 2).Value & " " & vbCrLf & _
                             wsList.Cells(i, 3).Value & " 様" & vbCrLf & vbCrLf & vbCrLf & _
                             wsMail.Range("B2").Value  'メール本文
                If Not (wsList.Cells(i, 7).Value) = 0 Then
                objMail.Attachments.Add wsList.Cells(i, 7).Value     '添付ファイル1。空白の場合はスキップ
                End If
                If Not (wsList.Cells(i, 8).Value) = 0 Then
                objMail.Attachments.Add wsList.Cells(i, 8).Value     '添付ファイル2。空白の場合はスキップ
                End If
                If Not (wsList.Cells(i, 9).Value) = 0 Then
                objMail.Attachments.Add wsList.Cells(i, 9).Value     '添付ファイル3。空白の場合はスキップ
                End If
                objMail.Save '下書き保存
               
        Next i
       
        Set objOutlook = Nothing
        MsgBox "下書き保存しました。メールの内容を確認の上、送信してください。"

    End Sub


    この場をお借りして、厚く御礼申し上げます。

    2019年8月8日 0:18

すべての返信

  • # 全角英数字が多用されていると、ちょっと読みにくい…。

    「メソッドまたはデータメンバーが見つかりません。」とのエラーメッセージが出ます。

    どの行を実行しようとした時に、そのエラーが表示されたのか、該当行を教えていただけますでしょうか?

    あるいは一行も実行されずにいきなりそのエラーが表示されるのでしょうか。その場合は Sub SendEmail() をどこに記述していて、それをどのように呼び出そうとしているのかを教えてください。

    それと…御提示いただいたコードだと、変数 mailItemObj が定義されていないように見受けられます。その VBA コードを書いているモジュールの先頭に「Option Explicit」を記載しておくことをお奨めします。

    2019年8月7日 1:43
  • 魔界の仮面弁士 様、皆様

    お忙しいところ回答していただき、ありがとうございます。

    「.To」の箇所にて、何らかの原因で引っかかっているようです。

    引き続き、よろしくお願いいたします。

    2019年8月7日 4:24
  • 添付頂いたコードで言うと:

    Dim objMail As Outlook.MailItem
    Set objMail = objOutlook.CreateItem(olMailItem)

    この objMail 変数は MailItem オブジェクトであるため、
     objMail.To = "anonymous@example.com"
    のように使うことができます。

    しかし現在書かれているコードは、objMail ではなく wsMail を操作しようとしていますよね。
    Dim wsMail As Excel.Worksheet なオブジェクトには To というプロパティが無いため、
     wsMail.To = "anonymous@example.com"
    のようには記述できず、エラーになってしまっているのだと思います。

    2019年8月7日 6:06
  • 魔界の仮面弁士 様、皆様

    お忙しいところ引き続き回答していただき、ありがとうございます。

    下記のとおり、一部を書き直してみました。

    Option Explicit
    Sub SendEmail()
     
    Dim objOutlook As Outlook.Application
    Dim i
    Dim rowMax As Long
    Dim wsList As Worksheet
    Dim wsMail As Worksheet
    Dim objMail As Outlook.MailItem
     
    Set objOutlook = New Outlook.Application
    Set wsList = ThisWorkbook.Sheets("送信先")
    Set wsMail = ThisWorkbook.Sheets("メール内容")
     
    With wsList
     
        '送信先の件数
        rowMax = .Cells(Rows.Count, 1).End(xlUp).Row
     
        '送信先の件数分繰り返す
        For i = 2 To rowMax
            Set objMail = objOutlook.CreateItem(olMailItem)
            With wsMail
                objMail.To = wsList.Cells(i, 4).Value       'メール宛先(To)
                objMail.cc = wsList.Cells(i, 5).Value       'メール宛先(cc)
                objMail.BCC = wsList.Cells(i, 6).Value      'メール宛先(BCC)
                objMail.subject = wsList.Range("B1").Value        'メール件名
                objMail.BodyFormat = olFormatPlain          'メールの形式
                objMail.Body = wsList.Cells(i, 1).Value & vbCrLf & _
                             wsList.Cells(i, 2).Value & " " & _
                             wsList.Cells(i, 3).Value & " 様" & vbCrLf & vbCrLf & _
                             wsMail.Range("B2").Value  'メール本文
                objMail.attached = wsList.Cells(i, 7).Value     '添付ファイル1
                objMail.attached = wsList.Cells(i, 8).Value     '添付ファイル2
                objMail.attached = wsList.Cells(i, 9).Value     '添付ファイル3
                objMail.Save '下書き保存
            End With
           
        Next i
       
        Set objOutlook = Nothing
        MsgBox "下書き保存しました。メールの内容を確認の上、送信してください。"
     
    End With

    End

    しかし、「オブジェクトは、このプロパティまたはメソッドをサポートしていません。」とのエラーが出て、かつどこでエラーが出たかの表示が出ません。

    お忙しいところ恐れ入りますが、引き続きよろしくお願いします。

    2019年8月7日 7:22
  • そもそも「With wsMail」が間違いなので、それを「With objMail」にするという意味でした。

    書き換えていただいたコードを見てみると、「.」で書き始める行がほぼなくなってしまったので、With ステートメントの存在意義が無くなっちゃいましたね。

    でも、そこまで直したのであれば、いっそ With は撤去した方がデバッグしやすそうです。

    「With wsList」と「With wsMail」と「End With」の行を削除して、
    『rowMax = .Cells(Rows.Count, 1).End(xlUp).Row』の行の先頭に、wsList を補いましょう。

    それと、Rows.Count という記述は ws何某.Rows.Count の記述に置き換えた方が良いと思います。今回は複数のワークシートを扱っていますので、どのシートの行数を数えているのか曖昧になるような記述は避けたほうが無難です。

    あと、「Dim i」の行で As 句を書き忘れているようです。As 句が無い場合、「既定のデータ型(既定のデータ型が設定されていなければ Variant)」として解釈されることになります。ここは型名を省略せず、Dim i As Integer もしくは Dim i As Long と記述しておいた方がよいでしょう。

    「オブジェクトは、このプロパティまたはメソッドをサポートしていません。」

    添付ファイルのところじゃないですかね。MailItem オブジェクトに attached というプロパティは存在しないはず。

    『objMail.Attachments.Add wsList.Cells(i, 7).Value』にしてみてください。

    それと…最後にある End は、End Sub の書き損じでしょうか? それとも本当に End ステートメントを記述しているという事でしょうか。

    2019年8月7日 9:09
  • 魔界の仮面弁士 様、皆様


    お忙しいところ引き続き回答していただき、ありがとうございます

    無事、目的を達成することができました。
    なお、ccや添付ファイルが無いことも想定して、以下のとおり書き換えました。


    Option Explicit
    Sub SendEmail()
     
    Dim objOutlook As Outlook.Application
    Dim i As Long
    Dim rowMax As Long
    Dim wsList As Worksheet
    Dim wsMail As Worksheet
    Dim objMail As Outlook.MailItem
     
    Set objOutlook = New Outlook.Application
    Set wsList = ThisWorkbook.Sheets("送信先")
    Set wsMail = ThisWorkbook.Sheets("メール内容")
     
     
        '送信先の件数
        rowMax = wsList.Cells(wsList.Rows.Count, 1).End(xlUp).Row
     
        '送信先の件数分繰り返す
            For i = 3 To rowMax
            Set objMail = objOutlook.CreateItem(olMailItem)
                If Not (wsList.Cells(i, 4).Value) = 0 Then
                objMail.To = wsList.Cells(i, 4).Value       'メール宛先(To)。空白の場合はスキップ
                End If
                If Not (wsList.Cells(i, 5).Value) = 0 Then
                objMail.cc = wsList.Cells(i, 5).Value       'メール宛先(cc)。空白の場合はスキップ
                End If
                If Not (wsList.Cells(i, 6).Value) = 0 Then
                objMail.BCC = wsList.Cells(i, 6).Value      'メール宛先(BCC)。空白の場合はスキップ
                End If
                objMail.subject = wsMail.Range("B1").Value  'メール件名
                objMail.BodyFormat = olFormatPlain          'メールの形式
                objMail.Body = wsList.Cells(i, 1).Value & vbCrLf & _
                             wsList.Cells(i, 2).Value & " " & vbCrLf & _
                             wsList.Cells(i, 3).Value & " 様" & vbCrLf & vbCrLf & vbCrLf & _
                             wsMail.Range("B2").Value  'メール本文
                If Not (wsList.Cells(i, 7).Value) = 0 Then
                objMail.Attachments.Add wsList.Cells(i, 7).Value     '添付ファイル1。空白の場合はスキップ
                End If
                If Not (wsList.Cells(i, 8).Value) = 0 Then
                objMail.Attachments.Add wsList.Cells(i, 8).Value     '添付ファイル2。空白の場合はスキップ
                End If
                If Not (wsList.Cells(i, 9).Value) = 0 Then
                objMail.Attachments.Add wsList.Cells(i, 9).Value     '添付ファイル3。空白の場合はスキップ
                End If
                objMail.Save '下書き保存
               
        Next i
       
        Set objOutlook = Nothing
        MsgBox "下書き保存しました。メールの内容を確認の上、送信してください。"

    End Sub


    この場をお借りして、厚く御礼申し上げます。

    2019年8月8日 0:18