メールにファイルを添付する or メールに表を貼り付ける マクロ

質問

こんにちは。
同じ質問を一週間ほど前にしたのですが、その後もわかっていなくて、どなたかご存知の方がいらっしゃればご教示いただけないでしょうか？
宜しくお願い致します。

送りたいメールの形は
数行の文章のあとに、表を貼り付け、また数行の文章という形式です。

Outlookメールでメールを立ち上げて
Comment1と2は文章ですのでエクセルのコラムを引っ張ってくるようにしているのですが、
Comment3部分に別のエクセルにある表をメタ貼りし、Comment4でまた文書を引っ張ってくるとさせたいのですが
Comment3部分の動きが出来ません。

Dim OlApp As Outlook.Application
Dim mItem As Outlook.MailItem

Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Recipient As String
Dim Msg As String
Dim Message As String
Dim Sender As String
Dim Comments As String
Dim Comments2 As String
Dim report As String

’日付の設定
DMY = Range("b_date")
DM = Format(Range("b_date").Value, "mmdd")

Worksheets("mail").Activate

'Create Outlook object
Set OutlookApp = New Outlook.Application
'Get the data

Subj = Range("B69") & "_" & DM
EmailAddr = Range("B63")
CCAddr = Range("B66")

Comment1 = Range("H63").Value
Comment2 = Range("H65").Value
Comment3 = この辺りがわかりません
Comment4　＝Range("H67").Value

'Compose message
Msg = "<font face=""Arial""><font size=2>"
Msg = Msg & Comment1 & "<BR><BR><BR>"
Msg = Msg & Comment2 & "<BR><BR><BR>"
Msg = Msg & Comment3 & "<BR><BR><BR>"
Msg = Comment4 & "<BR><BR><BR><BR>"

Msg = Msg & "Best regards," & "<BR><BR>"
Msg = Msg & "</font></font>"

'Create Mail Item
Set mItem = OutlookApp.CreateItem(olMailItem)
With mItem
.To = EmailAddr
.CC = CCAddr
.BCC = BCCAddr
.Subject = Subj
.HTMLBody = Msg
.Display

End With
End Sub

もしくは、貼り付けるのではなく、Rドライブに保存したファイル（表が記載してあるもの）を添付するという形式でも構いません。

宜しくお願い致します。

回答No.3

Wendy02 · ベストアンサー

こんにちは。

>management report" & "_" & DMにxlsを付けないとダメですか？
>management report" & "_" & DM.xlsは違いますよね・・？

それは、簡単に、このようにして実験しみたらどうでしょうか？

Sub TestFile()

DM = Format(Range("b_date").Value, "mmdd")

'こんな感じになります。
myFile = "R:\\P&L\2008\Management Report\management report" & "_" & DM & ".xls" 'Attached File

'　　↓
If Dir(myFile) ="" Then
　 MsgBox "ファイルが見つかりません。",48
Else
　MsgBox "ファイルがあります。"
End If

End Sub

お礼

ご連絡が遅れ申し訳ございません。

やっとこさ、完成しました！
ありがとうございました。
前回の質問も助けていただき、本当にありがとうございました。

お仕事お忙しいとの事ですので、風邪などひかれないようにお体ご自愛下さいね。

ありがとうございました！

回答No.2

Wendy02

こんにちは。

私の書き込みの残りの日数も限られてきました。次の再開の目処が立ちません。たぶん、戻ってこれるとは思いますが、次はいつになるか分かりません。時間があれば、作って上げられるのですが、表のサブルーチンだけは、細かすぎます。

＞ファイルもファイル全シートを送るのではなく、その中の一枚のみを送りたいのです。

それは、一旦、シートコピーをすればよいです。そして、それを保存しますと、シートのみのブックになりますから、それを添付させるようにすれば出来ます。そられは、記録マクロにしても、一般的なマクロでも、あまり大きい違いはないように思います。

お礼

書き込み日数とかあるのですね。
はい、

＞一旦、シートコピーをすればよいです。そして、それを保存しますと、シートのみのブックになりますから、それを添付させるようにすれば出来ます。そられは、記録マクロにしても、一般的なマクロでも、あまり大きい違いはないように思います

おっしゃる通り、今からやってみます！
結果問わず、ご連絡致します。

補足

Sub SendEmail_Management_report_HTML()

'Managementメールを作成する

Dim OlApp As Outlook.Application
Dim mItem As Outlook.MailItem

Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Recipient As String
Dim Msg As String
Dim Message As String
Dim Sender As String
Dim Comments As String
Dim Comments2 As String
Dim report As String

Dim myFile As String

Dim myAttach As Object
myFile = "R:\\P&L\2008\Management Report\management report" & "_" & DM 'Attached File

'日付の設定
DMY = Range("b_date")
DM = Format(Range("b_date").Value, "mmdd")

Worksheets("mail").Activate

'Create Outlook object
Set OutlookApp = New Outlook.Application
'Get the data

Subj = Range("B70") & "_" & DM
EmailAddr = Range("B64")
CCAddr = Range("B67")

Comment1 = Range("H64").Value
Comment2 = Range("H66").Value
Comment3 = Range("H68").Value
Comment4 = Range("H69").Value

'Compose message
Msg = "<font face=""Arial""><font size=2>"
Msg = Msg & Comment1 & "<BR><BR><BR>"
Msg = Msg & Comment2 & "<BR><BR><BR>"
Msg = Msg & Comment3
Msg = Msg & Comment4 & "<BR><BR><BR><BR>"

Msg = Msg & "Best regards," & "<BR><BR>"
Msg = Msg & "</font></font>"

'Create Mail Item
Set mItem = OutlookApp.CreateItem(olMailItem)
With mItem
.To = EmailAddr
.CC = CCAddr
.BCC = BCCAddr
.Subject = Subj
.HTMLBody = Msg
.Display
Set myAttach = .Attachments
myAttach.Add myFile
End With
End Sub

でmyAttach.Add myFileでエラーが出ます。
ファイルの指定でxlsがついていないからでしょうか？
management report" & "_" & DMにxlsを付けないとダメですか？
management report" & "_" & DM.xlsは違いますよね・・？

回答No.1

Wendy02

こんばんは。

>数行の文章のあとに、表を貼り付け、また数行の文章という形式です。
それは前回説明したとおりで、HTMLファイル自体をマクロで作るわけですから、罫線を引くように、公式化すればよいだけです。根気さえあれば出来ると思います。細かい作業をする根気が、今、こちらにないということです。

それが嫌なら、UWSC のようなキーボードマクロで貼り付ける、という手もあります。しかし、今回は、位置が定まらないような気がします。

添付なら、以下のようにすればよいです。
ただし、添付ファイルは、この場合は、xlsファイルか、pdf が一般的ですね。それ以外は、説明を入れておかないと、敬遠されるかもしれません。

　　Dim myFile As String
　　Dim myAttach As Object
　　myFile = "R:\Report0808.xls"　'Attached File
'-------------------------------------------　　
　With mItem
　 .To = EmailAddr
　 .CC = CCAddr
　 .BCC = BCCAddr
　 .Subject = Subj
　 .HTMLBody = Msg
　 .Display
　　Set myAttach = .Attachments
　　　　myAttach.Add myFile
　End With

お礼

こんにちは。

すみません。
＞罫線を引くように、公式化すればよいだけです。

という事について理解というより、全くどうしていいのかわからないのです。私の知識の範囲内では消化出来なくて。。。細かい作業は根気がいる作業はこちらがお願いしている身なので、そういった作業は避けて楽をしたいとかでは全くないです。気分を害してしまっていらしたら申し訳ございません。

ですので、自分でも解読出来る作業の添付にしようと思うのですが、
私のこれでは不十分のようで。
ファイルもファイル全シートを送るのではなく、その中の一枚のみを送りたいのです。

Sub SendEmail_CCM_HTML()

Dim OlApp As Outlook.Application
Dim mItem As Outlook.MailItem

Dim myFile As String
Dim myAttach As Object
myFile = "R:\\\P&L\2008\Management\management report_base.xls" 'Attached File
'-------------------------------------------

'日付の設定
DMY = Range("b_date")
DM = Format(Range("b_date").Value, "mmdd")

Comment1 = Range("H16").Value
Comment2 = Range("H18").Value
Comment3 = Range("H20").Value
Comment4 = Range("H22").Value

'Compose message
Msg = "<font face=""Arial""><font size=2>"
Msg = Msg & Comment1 & "<BR><BR><BR>"
Msg = Msg & Comment2 & "<BR><BR><BR>"

With mItem
.To = Range("B16")
.CC = Range("B19")
.Subject = Range("B22") & "_" & DM
.HTMLBody = Msg
.Display
Set myAttach = .Attachments
myAttach.Add myFile
End With
End Sub