[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『KEYWORDを含む複数PDFファイルをメールに添付したい』（しゅう）
ファイル添付がうまくいきません。
仕入先毎にMAILはうまく作成できます。
fileStorePath 、fileNameをローカルウィンドウで確認しましたら
うまく格納しておりました。
なぜでしょうか？
お力添えお願いいたします。
Sub 注文書メール作成()
Dim MAIL As Worksheet
Set MAIL = Worksheets("MAIL")
Dim RENRAKU As Worksheet
Set RENRAKU = Worksheets("連絡先")
Dim HONBUN As Worksheet
Set HONBUN = Worksheets("本文")
'MAILの最終行数をLRMとする
Dim LRM As Long LRM = MAIL.Cells(Rows.Count, 1).End(xlUp).Row
'********OUTLOOKMAIL作成********
Dim Outlook As Outlook.Application
Set Outlook = New Outlook.Application
Dim NewMail As Outlook.MailItem
'
Dim TANTOU As Variant
Dim attached As String
'メールを作成する
'MAILの８行目から最終行まで
For i = 8 To LRM
Set NewMail = Outlook.CreateItem(olMailItem)
'メールアイテムオブジェクト作成
Dim mailItemObj As Outlook.MailItem
Set mailItemObj = Outlook.CreateItem(olMailItem)
'添付ファイルオブジェクト作成
Dim attachObj As Outlook.Attachments
Set attachObj = mailItemObj.Attachments
With NewMail
Supplier = MAIL.Cells(i, 1).Value
TANTOU = MAIL.Cells(i, 2).Value
'メール宛先
'.To = Cells(i, 4).Value
'.CC = Cells(i, 5).Value
'メール件名
.Subject = "【" & Supplier & "様】新規注文書_" & Format(Date, "yyyy/mm/dd")
'メールの形式
.BodyFormat = olFormatHTML
'メール本文
.Body = Supplier & vbLf & _
TANTOU & "様" & vbLf & _
HONBUN.Cells(1, 1).Value
'メールアイテムにファイルを添付する
Dim keyword As String
keyword = Cells(i, 1).Value
Call FileAttach(attachObj, keyword)
End With
NewMail.Save 'NewMail.Send
Next i
Set Outlook = Nothing
End Sub
' 【機能】下書きメールアイテムにファイルを添付する
' 複数ファイル添付可能（キーワードを含むファイルをすべて添付する）
' キーワードを含むファイルが見つからない場合、何も添付しない
Sub FileAttach(attachObj As Object, keyword As String)
Dim MAIL As Worksheet
Set MAIL = Worksheets("MAIL")
Dim fileStorePath As String 'ファイル格納パス
fileStorePath = MAIL.Range("C2") & "\"
Dim fileName As String
fileName = Dir(fileStorePath & "\" & "*")
'フォルダ内のファイル数、検索を繰り返す
Do While fileName <> ""
'キーワードを含むファイルが見つかったら、下書きアイテムに添付する
If InStr(fileName, keyword) > 0 Then
attachObj.Add fileStorePath & "\" & fileName
End If
fileName = Dir()
Loop
Set attachObj = Nothing
End Sub
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
（γ） 2021/07/21(水) 07:41
fileStorePath = MAIL.Range("C2") & "\"
~~~
↑なので
fileName = Dir(fileStorePath & "*") attachObj.Add fileStorePath & fileName
が正しいのではないですか？（勘違いだったらごめんなさい）
（もこな２ ） 2021/07/21(水) 08:02
Y様
Set attachObj = Nothing をしているのはなぜ？ せっかく作ったのに。 ⇒よくわからないです。 サンプルコピーしただけなので・・・・ ここはなしでいいのですか？
もこな様
Dim fileStorePath As String 'ファイル格納パス
fileStorePath = MAIL.Range("C2") & "\"
Dim fileName As String
fileName = Dir(fileStorePath & "*")
'キーワードを含むファイルが見つかったら、下書きアイテムに添付する
If InStr(fileName, keyword) > 0 Then
attachObj.Add fileStorePath & fileName
になおしてみたんですけど
うまくいかないです。
attachObj.Add fileStorePath & fileName
ここだけうまくいってないので
fileStorePath & fileNameが怪しいんですけど
なんででしょうか？
ご教授いただきたくお願いいたします。
しゅう
（しゅう） 2021/07/21(水) 10:53
＞ 'メールアイテムにファイルを添付する ＞ Dim keyword As String ＞ keyword = Cells(i, 1).Value
Cellsの親シートが特定されてないですよ。MAILシートなら、↓とする
keyword = MAIL.Cells(i, 1).Value
（半平太） 2021/07/21(水) 11:33
'半平太様 ご返信誠にありがとうございます。 下記へなおしてみましたがやはりATTACHされないです。
メールアイテムにファイルを添付する
Dim keyword As String
keyword = MAIL.Cells(i, 1).Value
Call FileAttach(attachObj, keyword)
なぜでしょうか？ ご教授いただきたく。とりあえずアナログでやります！
と
（しゅう） 2021/07/21(水) 13:10
参考に私が整理（というか普段自分が使っているメールマクロを改造）したものを置いておきます
（レイトバインディング（参照設定なし）ですが、整理の参考にはなると思います）
Sub 注文書メール作成_改()
Dim mailOBJ As Object
Dim i As Long
With Worksheets("MAIL")
For i = 8 To .Cells(Rows.Count, 1).End(xlUp).Row
Set mailOBJ = CreateObject("Outlook.Application").CreateItem(0)
'メール件名
mailOBJ.Subject = "【" & .Cells(i, 1).Value & "様】新規注文書_" & Format(Date, "yyyy/mm/dd")
'メールの形式
mailOBJ.BodyFormat = 2
'メール本文
mailOBJ.Body = .Cells(i, 1).Value & vbLf & .Cells(i, 2).Value & "様" & vbLf & Worksheets("本文").Cells(1, 1).Value
'添付ファイル処理を呼び出し(半平太さん指摘部分に留意)
Call 添付ファイル処理(mailOBJ, .Range("C2") & "\", .Cells(i, 1).Value)
'下書きフォルダへ保存
mailOBJ.Save
Next i
End With
End Sub
'----------------------------------------------------------------------------------------------------------
Sub 添付ファイル処理(mailOBJ As Object, MyPath As String, Keyword As String)
Dim ファイル名 As String
ファイル名 = Dir(MyPath & "*.pdf")
Do Until ファイル名 = ""
If ファイル名 Like "*" & Keyword & "*" Then mailOBJ.Attachments.Add MyPath & ファイル名
ファイル名 = Dir()
Loop
End Sub
（もこな２） 2021/07/21(水) 14:00
| Set attachObj = Nothing | をしているのはなぜ？ せっかく作ったのに。 | ⇒よくわからないです。 | サンプルコピーしただけなので・・・・ | ここはなしでいいのですか？
SaveなりSendなりの前に Set .. = Nohthing としてしまったら、 せっかく作った添付ファイル情報は消されますよ。 SaveなりSendのあとにすればよいと思います。
NewMailと mailItemObj の二つがあるのは何故ですか？ 全般によく整理して、それぞれのコードの意味を考えられたほうがよいと思います。 （γ） 2021/07/21(水) 16:03
変数の定義を上部にまとめさせてもらいます。
細かいコーディングエラー(でも無害なところ）は無視しています。 こちらでは、以下でアタッチできています。
Sub 注文書メール作成()
Dim i As Long
Dim Supplier
Dim MAIL As Worksheet
Dim RENRAKU As Worksheet
Dim HONBUN As Worksheet
Dim LRM As Long
Dim Outlook As Outlook.Application
Dim NewMail As Outlook.MailItem
Dim TANTOU As Variant
Dim attached As String
Dim mailItemObj As Outlook.MailItem
Dim attachObj As Outlook.Attachments
Dim Keyword As String
Set MAIL = Worksheets("MAIL")
Set RENRAKU = Worksheets("連絡先")
Set HONBUN = Worksheets("本文")
'MAILの最終行数をLRMとする
LRM = MAIL.Cells(Rows.Count, 1).End(xlUp).Row
'********OUTLOOKMAIL作成********
Set Outlook = New Outlook.Application
'
'メールを作成する
'MAILの８行目から最終行まで
For i = 8 To LRM
' Set NewMail = Outlook.CreateItem(olMailItem)
'メールアイテムオブジェクト作成
Set mailItemObj = Outlook.CreateItem(olMailItem)
'添付ファイルオブジェクト作成
Set attachObj = mailItemObj.Attachments
With mailItemObj
Supplier = MAIL.Cells(i, 1).Value
TANTOU = MAIL.Cells(i, 2).Value
'メール宛先
'.To = Cells(i, 4).Value
'.CC = Cells(i, 5).Value
'メール件名
.Subject = "【" & Supplier & "様】新規注文書_" & Format(Date, "yyyy/mm/dd")
'メールの形式
.BodyFormat = olFormatHTML
'メール本文
.Body = Supplier & vbLf & _
TANTOU & "様" & vbLf & _
HONBUN.Cells(1, 1).Value
'メールアイテムにファイルを添付する
Keyword = MAIL.Cells(i, 1).Value '親シートを限定する。でもこれってSupplierと同じではないですか？
Call FileAttach(attachObj, Keyword)
End With
mailItemObj.Save
'NewMail.Send
Next i
' mailItemObj.Display
Set Outlook = Nothing
End Sub
' 【機能】下書きメールアイテムにファイルを添付する
' 複数ファイル添付可能（キーワードを含むファイルをすべて添付する）
' キーワードを含むファイルが見つからない場合、何も添付しない
Sub FileAttach(attachObj As Object, Keyword As String)
Dim MAIL As Worksheet
Dim fileStorePath As String 'ファイル格納パス
Dim fileName As String
Set MAIL = Worksheets("MAIL")
fileStorePath = MAIL.Range("C2") & "\"
fileName = Dir(fileStorePath & "*")
'フォルダ内のファイル数、検索を繰り返す
Do While fileName <> ""
'キーワードを含むファイルが見つかったら、下書きアイテムに添付する
If InStr(fileName, Keyword) > 0 Then
attachObj.Add fileStorePath & fileName
End If
fileName = Dir()
Loop
End Sub
（半平太） 2021/07/21(水) 16:17
Sub 注文書メール作成_改二()
Dim Outlook As Outlook.Application
Dim i As Long
Dim MAIL As Worksheet, RENRAKU As Worksheet, HONBUN As Worksheet
Dim ファイル名 As String
Set MAIL = Worksheets("MAIL")
Set RENRAKU = Worksheets("連絡先")
Set HONBUN = Worksheets("本文")
Set Outlook = New Outlook.Application
For i = 8 To MAIL.Cells(MAIL.Rows.Count, 1).End(xlUp).Row
With Outlook.CreateItem(olMailItem)
.Subject = "【" & MAIL.Cells(i, 1).Value & "様】新規注文書_" & Format(Date, "yyyy/mm/dd") 'メール件名
.BodyFormat = olFormatHTML 'メールの形式
.Body = MAIL.Cells(i, 1).Value & vbLf & MAIL.Cells(i, 2).Value & "様" & vbLf & Worksheets("本文").Cells(1, 1).Value 'メール本文
'添付ファイル処理
ファイル名 = Dir(MAIL.Range("C2").Value & "\" & "*.pdf")
Do Until ファイル名 = ""
If ファイル名 Like "*" & MAIL.Cells(i, 1).Value & "*" Then
.Attachments.Add MAIL.Range("C2").Value & "\" & ファイル名
End If
ファイル名 = Dir()
Loop
.Save '下書きフォルダへ保存
End With
Next i
End Sub
（もこな２） 2021/07/21(水) 17:37
お世話になります。
ご教授いただき誠にありがとうございます！
いちいち変数にするまでもない部分を統合したりして、一旦コードを整理してみてはどうですか？
⇒そうですよね。もっと意味を理解して
コードの整理をしてみます。
サンプルありがとうございます！
できました！感動です！！！
もっと勉強します！
（しゅう） 2021/07/22(木) 00:03
ご返信ありがとうございます。
全般によく整理して、それぞれのコードの意味を考えられたほうがよいと思います ⇒まだまだ理解していないことを痛感いたしました。
ありがとうございます。
もっと勉強します。
半平太様
お世話になります。
すごいです！できました！感動です！
コードの書き方もかなりスッキリしていて
学ぶことがたくさんです！
このコードをかくのにさくっとかけるのですか？
SEとかのお仕事されているんですか？
私ももっと勉強します！
ありがとうございます！
もこな２様
ありがとうございます。
こちらのコードもためしました！
ばっちり動きました！
感動です(:_;)
こんなにも短いコードでいけるのですね。。。。
私のはいったい。。。
本当にありがとうございます。
次の大量の発注書が楽しみですｗ
しゅう
（しゅう） 2021/07/22(木) 00:09
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.