VBA 実行時エラー'438' の解決

前提・実現したいこと

エクセルのVBAとOutlookを連携させて一括送信メーラーを創っています。
一括送信メーラーにファイル添付機能を追加するため、
以前創ったVBAと統合した所、以下のエラーメッセージが発生しました。

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

実行時エラー'438'オブジェクトは、このプロパティまたはメソッドをサポートしていません。

該当のソースコード

VBA
1Sub ovba()
2
3
4'ファイルの選択ダイアログを表示して
5'ファイルのパスを取得します
6
7Dim fType, prompt As String
8Dim fPath As Variant
9Dim ws As Worksheet
10Dim ObjMail As Object
11
12
13Dim objOutlook As Outlook.Application
14Dim i   As Long
15Dim rowMax As Long
16Dim wsList As Worksheet
17
18Set ObjMail = CreateObject("Outlook.Application")
19
20Set objOutlook = New Outlook.Application
21Set wsList = ThisWorkbook.Sheets("送信先")
22Set wsMail = ThisWorkbook.Sheets("メール内容")
23
24'選択できるファイルの種類はすべてのファイル
25fType = ""
26
27
28'ダイアログのタイトルを指定
29prompt = "Excelファイルを選択して下さい"
30'ファイル参照ダイアログの表示
31fPath = Application.GetOpenFilename(fType, , prompt)
32
33If fPath = False Then
34'ダイアログでキャンセルボタンが押された場合は処理を終了します
35End
36End If
37
38'B2セルにファイル名をセット
39wsMail.Cells(10, 3).Value = fPath
40
41
42
43
44'--- 添付ファイルのパス ---'
45Dim attachmentPath As String
46attachmentPath = fPath
47    
48'--- 添付ファイルを設定 ---'
49Call ObjMail.Attachments.Add(attachmentPath)
50
51
52With wsList
53
54    '送信先の件数
55    rowMax = .Cells(Rows.Count, 1).End(xlUp).Row
56    
57    '送信先の件数分繰り返す
58    For i = 2 To rowMax
59        Set ObjMail = objOutlook.CreateItem(olMailItem)
60        With ObjMail
61            ObjMail.To = wsList.Cells(i, 4).Value 'メール宛先
62            ObjMail.Subject = wsMail.Range("B1").Value 'メール件名
63            ObjMail.BodyFormat = olFormatPlain     'メールの形式
64            ObjMail.Body = wsMail.Range("B2").Value  'メール本文
65            ObjMail.Display 'Outlookの下書きをDisplayする
66        End With
67    Next i
68    
69End With
70
71
72
73        
74End Sub
75

試したこと

438エラー自体はよく遭遇します。
今回、デバッガが49行目のCall ObjMail.Attachments.Add(attachmentPath)で止まるので、
添付ファイルのアップロード処理を記述したfpath近辺のVBAがおかしいと思い試行錯誤しております。

また、前半のDim objOutlookとDim ObjMailの変数宣言でも同一の処理を入力してしまっていると思い、
今手入力で新しくVBAを創りなしてデバッグしています。

もしこの438エラーの原因等がおわかりになれば教えてください。
よろしくお願いします。

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

Windows10
Excel 2019
Outlook 2019

行動規範の内容に同意します

回答2件

ExcelVBA
1Option Explicit
2
3'# 「ツール」→「参照設定」から
4'#「Microsoft Outlook XX.X Object Library」を参照設定すること
5Sub ovba()
6    Dim objOutlook As Outlook.Application
7    Dim attachmentPath As Variant
8    Dim i As Long
9    Dim wsList As Worksheet
10    Dim wsMail As Worksheet
11
12    Set objOutlook = New Outlook.Application
13    Set wsList = ThisWorkbook.Sheets("送信先")
14    Set wsMail = ThisWorkbook.Sheets("メール内容")
15
16    '--- 添付ファイルのパスの取得 ---'
17    attachmentPath = Excel.Application.GetOpenFilename( _
18                     "Microsoft Excelブック,*.xls?", , "添付ファイルの選択")
19    'ダイアログでキャンセルボタンが押された場合は処理を終了します
20    If attachmentPath = False Then Exit Sub
21
22    '送信先の件数分繰り返す
23    For i = 2 To wsList.Cells(wsList.Rows.Count, 1).End(xlUp).Row
24        With objOutlook.CreateItem(olMailItem)      'メールの作成
25            .BodyFormat = olFormatPlain             'メールの形式
26            .To = wsList.Cells(i, 4).Value          'メール宛先
27            .Subject = wsMail.Range("B1").Value     'メール件名
28            .Body = wsMail.Range("B2").Value        'メール本文
29            .Attachments.Add (attachmentPath)       '添付ファイル
30            .Display                                'Outlookの下書きをDisplayする
31            '.Send                                   '送信の命令は不要？
32        End With
33    Next
34End Sub

変数の登場数が多すぎてごっちゃになってるのでは？
変数っていうくらいだから、次々変わらないものは直接書くか定数で。
あと、不要な空白行も読みにくくないですか？
適当に添削してみました。
あと、やっぱり、操作対象が何かちゃんと意識して、
何に対して命令するのか、
何に対して何の設定を設定するのか、
意識して書きましょう。

参考になれば。。。。

投稿2020/04/08 08:18

mattuwan

総合スコア2136

r_o_234

2020/04/08 08:55

mattuwanさん前回はありがとうございました！今回も丁寧に添削していただき、誠に感謝です！ご指摘の通り、不要な空白行や操作対象の意識、何に対しての命令、設定なのか意識を変えていきます。さて、添削して頂いたコードを実行した所、コンパイルエラー:メソッドまたはデータメンバーが見つかりません(22行目が原因？) と表示されてしまいました。色々試行錯誤した結果煮詰まってしまっているので、時間を置いてから再着手してみます。ありがとうございました！

mattuwan

2020/04/08 10:20

どの行でしょ？行番で何かしたことないので、どの行のコードお示しください。一応コンパイルまではしたのですが。。。

r_o_234

2020/04/13 02:14

mattuwanさん　返信ありがとうございます。　こちらの返信が遅れましてすみません、体調崩して寝込んでおりました。エラー内容と行ですが、　コンパイルエラー　メソッドまたはデータメンバーが見つかりません。　というエラーが表示され、　デバッグの黄色いポインタが3行目(5行目)のSub ova()で止まり、 16行目のattachmentPath = Excel.ApplicationGetOpenFilename( _ の、 ".ApplicationGetOpenFilename( _" が青く選択されています。　こちら、もしおわかりになればよろしくお願いします。また、もっと大きなエラーの要因として、　要件定義・設計の段階で一括送信メーラー開発の大づかみな全体の見通しがついていない事が原因だと思い、　今、大づかみな全体の要件・設計から再着手しております。

mattuwan

2020/04/13 03:13

ピリオドが、抜けてますが？よく見てください。

r_o_234

2020/04/13 04:11

mattuwanさん　指摘ありがとうございます。　Excel.Application.GetOpenFilenameにピリオドを入れ直しで修正した所、1つ進み今度は　実行時エラー'440' 　オブジェクトはこのメソッドをサポートしていません。　というエラーに代わりました。　デバッグするとポインタが24行目の.To wsList.Cells(i, 4).Value'メール宛先　で止まります。　.To→objOutlook.Toと修正すれば良いのでしょうか。　おわかりになればお願いします。

r_o_234

2020/04/13 05:33

mattuwanさん解決しました。下のttyp03さんのVBAを新しく手入力で書き上げた所、正常に動作しました。 mattuwanさんもご協力本当にありがとうございます。変数・空白行・意識等勉強になりました！

行動規範の内容に同意します

ベストアンサー

添付ファイルというのはOutlookに対してするのではなく、メールに対して添付するものですよね？
今の実装はOutlookに対して行っています。

VBA
1Set ObjMail = CreateObject("Outlook.Application")
2～省略～
3Call ObjMail.Attachments.Add(attachmentPath)

作成するメールに対して添付すればOK

VBA
1Set ObjMail = CreateObject("Outlook.Application")
2～省略～
3'Call ObjMail.Attachments.Add(attachmentPath) この行は削除
4
5With wsList
6
7    '送信先の件数
8    rowMax = .Cells(Rows.Count, 1).End(xlUp).Row
9
10    '送信先の件数分繰り返す
11    For i = 2 To rowMax
12        Set ObjMail = objOutlook.CreateItem(olMailItem)
13        With ObjMail
14            .To = wsList.Cells(i, 4).Value 'メール宛先
15            .Subject = wsMail.Range("B1").Value 'メール件名
16            .BodyFormat = olFormatPlain     'メールの形式
17            .Body = wsMail.Range("B2").Value  'メール本文
18            .Attachments.Add attachmentPath ' ★ここに追加
19            .Display 'Outlookの下書きをDisplayする
20        End With
21    Next i
22
23End With

余談ですが折角With使っているのにその中でObjMailを書いていたので修正してます。
あと動作確認はしていませんのであしからず。

修正版全コード

VBA
1Sub ovba()
2
3    'ファイルの選択ダイアログを表示して
4    'ファイルのパスを取得します
5
6    Dim fType, prompt As String
7    Dim fPath As Variant
8    Dim ws As Worksheet
9    Dim ObjMail As Object
10
11
12    Dim objOutlook As Outlook.Application
13    Dim i   As Long
14    Dim rowMax As Long
15    Dim wsList As Worksheet
16
17'    Set ObjMail = CreateObject("Outlook.Application") ★この行削除
18
19    Set objOutlook = New Outlook.Application
20    Set wsList = ThisWorkbook.Sheets("送信先")
21    Set wsMail = ThisWorkbook.Sheets("メール内容")
22
23    '選択できるファイルの種類はすべてのファイル
24    fType = ""
25
26
27    'ダイアログのタイトルを指定
28    prompt = "Excelファイルを選択して下さい"
29    'ファイル参照ダイアログの表示
30    fPath = Application.GetOpenFilename(fType, , prompt)
31
32    If fPath = False Then
33        'ダイアログでキャンセルボタンが押された場合は処理を終了します
34        End
35    End If
36
37    'B2セルにファイル名をセット
38    wsMail.Cells(10, 3).Value = fPath
39
40    '--- 添付ファイルのパス ---'
41    Dim attachmentPath As String
42    attachmentPath = fPath
43
44    '--- 添付ファイルを設定 ---'
45'    Call ObjMail.Attachments.Add(attachmentPath) ★この行削除
46
47    With wsList
48
49        '送信先の件数
50        rowMax = .Cells(Rows.Count, 1).End(xlUp).Row
51
52        '送信先の件数分繰り返す
53        For i = 2 To rowMax
54            Set ObjMail = objOutlook.CreateItem(olMailItem)
55            With ObjMail
56                .To = wsList.Cells(i, 4).Value 'メール宛先
57                .Subject = wsMail.Range("B1").Value 'メール件名
58                .BodyFormat = olFormatPlain     'メールの形式
59                .Body = wsMail.Range("B2").Value  'メール本文
60                .Attachments.Add attachmentPath ' ★この行追加
61                .Display 'Outlookの下書きをDisplayする
62            End With
63        Next i
64
65    End With
66End Sub

投稿2020/04/08 06:55

編集2020/04/13 04:56

ttyp03

総合スコア16998

r_o_234

2020/04/08 08:57

ttyp03さんご回答ありがとうございます！添付ファイルはメールに対して添付するものであっています。ご教授頂いたコードを試しましたが上手くいかず、色々試行錯誤した結果煮詰まってしまっているので、時間を置いてから再着手してみます。ありがとうございました！

ttyp03

2020/04/09 00:28 編集

> 添付ファイルはメールに対して添付するものであっています。一般的な考え方の話をしただけで質問したわけではございません。 > 上手くいかず上手くいかない内容を書いてくれないとアドバイスできません。

r_o_234

2020/04/13 01:57

ttyp03さん　返信ありがとうございます。　こちらの返信が遅れましてすみません、体調崩して寝込んでおりました。上手くいかない内容ですが、教えて頂いたコードを手入力で試したところ、エラー内容は、実行時エラー:438 オブジェクトは、このプロパティまたはメソッドをサポートしていませんと表示されます。 46行目のCall ObjMail.Attachments.Add(atacchmentPath)でポインタが止まります。　こちら、もしおわかりになればよろしくお願いします。

ttyp03

2020/04/13 02:01

回答のコードにも書きましたが、その行は削除してください。

r_o_234

2020/04/13 02:30

ttyp03さん　すみません、複数ある別のVBAを実行しており、さっきの返信は間違ってました。　Call ObjMail.Attachments.Add(attachmentPath) の行は削除済です。　ttyp03さん版のVBAを実行した所、　実行時エラー"424" 　オブジェクトが必要です。と表示され、 15行目のSet objMail = objOutlook.CreateItem(olMailItem) でポインタが止まります。もしおわかりになればお願いします。 (また、要件定義・設計の段階からVBAツールを創り直す方が良いと思い今着手しております。)

ttyp03

2020/04/13 02:37

そこらへんは修正する指示は出していませんが。。。他のとゴッチャになってないですか？

r_o_234

2020/04/13 04:26

ttyp03さん返信ありがとうございます。ここは修正しておりませんが、元々のVBA自体にエラーがあって、重複する記述の箇所があるため、それが原因で"424"エラーを吐いてるのかと思いました。 Set ObjMail = CreateObject("Outlook.Application") Set objOutlook = New Outlook.Application Set ObjMail = objOutlook.CreateItem(olMailItem) この3行が同じ重複した処理を述べている事が原因かなと思います。 (…が、これを削除してobjMail,objOutlookの変数を1個に合わせてもエラー吐いた記憶があります。) もし何かおかしいところをお気づきになれば、アドバイスをお願いします。

ttyp03

2020/04/13 04:57

上2行と下1行は同じ処理ではないですね。混乱しているようなので、全体的に修正したコードを回答しました。こちらは動作確認もできていますので、お試しください。

r_o_234

2020/04/13 05:31

ttyp03さん解決しました。 ttyp03さんのVBAを新しく手入力で書き上げた所、正常に動作しました。これで、一括送信メーラーのα版ということで動作確認しました。 (あとは添付ファイルを複数指定可能に変更すれば完成です) 修正版全コードの方も試してみます。ご協力本当にありがとうございました！助かりました！

行動規範の内容に同意します

あなたの回答