VBAでメールにアクティブブックを添付したい

質問

EXCEL2003を使用しています。

・アクティブブックを保存し、メールに添付
・送信先アドレス、件名を指定

ということをVBAで行ないたいです。

調べてみた所、メール送信に関するVBAの記述としては「SendMailメソッド」を使えばいいらしいのですが、こちらは送信まで行なってしまうようです。
でも今回の場合は自動送信ではなく、上記の通り送信の直前で止めたいのです。
（本文記述と送信ボタン押下は手動）

できればメニューの[ファイル]-[送信]機能ではなく、VBAで処理したいのですが…どうすればいいのでしょうか。

回答No.2

米沢 栄蔵（@YON56）

次のサイトにアクセスしてみては、
http://www.hi-ho.ne.jp/babaq/basp21.html

きっとヒントがありますよ。

お礼

リンク先拝見しました。
おお、見慣れない単語が満載です（笑）
勉強してみます。
どうもありがとうございました。

回答No.1

DOUGLAS_

＞調べてみた所、メール送信に関するVBAの記述としては「SendMailメソッド」を使えばいいらしいのですが、こちらは送信まで行なってしまうようです。
　そうですね。「送信」以前に「添付」ができないと存じます。

＞・アクティブブックを保存し、
＞・送信先アドレス、件名を指定
　これだけでしたら、いろんな方法があろうかと存じますが、

＞今回の場合は自動送信ではなく、上記の通り送信の直前で止めたいのです。
＞（本文記述と送信ボタン押下は手動）
ということになりますと、一旦開いたメールメッセージに SendKeys ステートメント で無理矢理添付ファイルを指定するようなことになりましょうか（恐らくできないと存じますが。。。）。
　私は全然判りませんが、API か何かで メールメッセージ の ウィンドウ の プロパティ を取得できれば、ファイルを添付することもできるかも知れませんが。。。

＞メールに添付
＞できればメニューの[ファイル]-[送信]機能ではなく、VBAで処理したい
ということでしたら、「本文記述」は メールメッセージ 内ではなくて、ワークシート 内か テキストボックス ぐらいに書き込むようにして、準備万端整えてから、ＣＤＯ を利用して送信するみたいなことになるかと存じます。
　もしくは、ＣＤＯ に メールメッセージ を再編集するような メソッド があれば、まさに、お望みの通りなのですが、ちょっとＷＥＢ検索してみても、みつかりませんでした。

　ＣＤＯ の使い方につきましては、下記をご覧ください。ＶＢＡ ではなくて ＶＢＳ（WSH）の記述ですが、ＶＢＡ でも応用できますが、ＯＳ に依存します。

●Windows標準機能とWSHを使ってメールを送信する
http://www.atmarkit.co.jp/fwin2k/win2ktips/428wshmail/wshmail.html

Sub CDO使用例()
　Dim oMsg As Object
　Set oMsg = CreateObject("CDO.Message")
　With oMsg
　　.From = "送信者<hoge@hoge.com>"
　　.To = "宛先<hoge1@hoge.com>"
　　.Cc = "ＣＣ１<hoge2@hoge.com>,ＣＣ２<hoge3@hoge.com>"
　　.Bcc = "ＢＣＣ<hoge4@hoge.com>"
　　.Subject = "件名"
　　.TextBody = "本文"
　　.AddAttachment "D:\hoge\hoge.xls"
　　.Send
　End With
End Sub

　あるいは、添付ファイルを付けることはできませんが、下記のような方法もあります。
Sub MAILTO()
　ActiveWorkbook.FollowHyperlink _
　　"mailto:宛先１<hoge1@hoge.com>?cc=ＣＣ１<hoge2@hoge.com>&cc=ＣＣ２<hoge3@hoge.com>&bcc=ＢＣＣ<hoge4@hoge.com>&subject=件名&body=本文"
End Sub

　いずれのマクロも、ワークシートの中にメールアドレスなどを配置しておいて、下記のように内容を指定することもできます。

【CDO使用例】
With oMsg
　.From = "送信者<hoge@hoge.com>"
　.To = Range("A1").Value & "<" & Range("B1").Value & ">"
　.Cc = Range("A2").Value & "<" & Range("B2").Value & ">," _
　　　& Range("A3").Value & "<" & Range("B3").Value & ">"
　.Bcc = Range("A4").Value & "<" & Range("B4").Value & ">"
　.Subject = Range("A5").Value
　.TextBody = Range("B5").Value
　.AddAttachment "D:\hoge\hoge.xls"
　.Send
End With

【MAILTO】
ActiveWorkbook.FollowHyperlink _
　"mailto:" & Range("A1").Value & "<" & Range("B1").Value & ">" & _
　"?cc=" & Range("A2").Value & "<" & Range("B2").Value & ">" & _
　"&cc=" & Range("A3").Value & "<" & Range("B3").Value & ">" & _
　"&bcc=" & Range("A4").Value & "<" & Range("B4").Value & ">" & _
　"&subject=" & Range("A5").Value & _
　"&body=" & Range("B5").Value

お礼

ご回答ありがとうございます。
なかなか難しいようですね。。。
添付がつけられないようでしたら、動作テストが大変そうなVBAは避けて、普通にハイパーリンクで対応してみようと思います。