ExcelVBAで、シートを本文として送信したい

質問

こんにちは。初めて質問させていただきます。
Excelを使用する仕事をしています。
シートを本文としてメールを送信する業務が毎日大量にあり、
普段はExcelのツールからメール送信を選択し、作業を行っておりましたが
最近、送信先や送信データが増えてしまい困っています。

VBAでなんとか出来ないかと、試行錯誤したのですがうまく出来ません。
どうかお知恵を貸して頂けないでしょうか？
お願い致します。
ちなみに、送り先の事情でファイル添付は出来ない状況です。

OSはExcel、OutLookともに2002です。
VBAのスキルは基本的に自動書記を加工するという程度ですが
一応変数なども（なんとか）理解しています。

回答No.3

Wendy02 · ベストアンサー

こんばんは。#2 で書かせていただいた者です。

>やはりお客様あてにお送りする内容なので罫線などの書式がないと納得してもらえません。

それは、まったく話がぜんぜん違いますね。

それは、一般のメール形式ではありませんし、そのメールは、リッチテキストですが、私は、Excel VBAでは、その表現方法もしくは変換方法を知りません。もちろん、セル自体に、------ という線を入れることは可能ですが、あくまでも、テキスト形式の範囲内のことです。確か、リッチテキストは、VBの分野だったと思います。ExcelのHTMなどの圧縮Webファイルスタイルは、Outlook では、単純なHTML形式に読み出してしまうようで、表現力が落ちてしまいます。

もしも、表示形式やレイアウトや図が必要なら、それは、Wordの分野の話ではありませんか？一旦、rtf 形式で作ったものを、sendmail の文章に送るという方法なら可能かと思います。

または、専用メーラーがあるかもしれません。Excelという範疇では、私には分かりません。

お礼

再度の回答ありがとうございます。

普段なにげなく使っているツールバーでの作業でしたので
つい簡単にマクロの記述が出来るものだと思い込んでいました。
WordやVBを調べてみようと思います。

ここで質問させていただいてよかったです。
本当にありがとうございました。
一旦ここで締め切らせていただきます。

回答No.2

Wendy02

こんにちは。

>テキストとして貼り付けるのではなく図として貼り付ける方法を模索しております。

添付ファイルでないものを、図として送信させるのというのは不可能だと思います。一旦、テキスト化させて、それをメールに含めるという形にしたらどうかと思います。

以下をコメント・ブロック('をつける)をすれば、内容の表示はしなくなります。
.Display 'メールの確認

ただし、自動送信はされておりません。
また、テキストファイルとは言え、シート全体をテキスト化しますので、不要なところにデータがあると、巨大になりすぎることがありますので、気をつけてください。後は、個々に工夫が必要かもしれません。

Sub OutLookSendMail()
　　Dim Fno As Integer
　　Dim tmp As String
　　Dim buf As String
　　Dim MailContent As String
　　Dim MyOl As Object
　　Dim MyNMSpace As Object
　　Dim MyMail As Object
　　Set MyOl = CreateObject("Outlook.Application")
　　Set MyNMSpace = MyOl.GetNamespace("MAPI")
　　Set MyMail = MyOl.CreateItem(0)
　　'WYSWYG のテキストファイル作成
　　Fno = FreeFile()　　
　　Application.DisplayAlerts = False
　　ActiveSheet.Cells.Copy
　　Workbooks.Add
　　ActiveSheet.Range("A1").PasteSpecial (xlPasteValues)
　　ActiveSheet.SaveAs "Temp.Txt", xlTextPrinter
　　ActiveWorkbook.Close
　　Application.DisplayAlerts = True

　　Open "Temp.txt" For Input As #Fno
　　Do Until EOF(Fno)
　　　　Line Input #Fno, tmp
　　　 buf = buf & vbCrLf & tmp
　　　 tmp = ""
　　Loop
　　　Close #Fno

　　With MyMail
　　　　.To = "xxxxxxx@xxxxxxx"　'宛先のMAIL_Address
　　　　.Subject = "連絡表"　　'タイトル
　　　　.body = buf　'本文
　　　　.Display 'メールの確認
　　End With
　　Kill "Temp.txt"　'Tempファイルの削除
　　Set MyOl = Nothing
　　Set MyNMSpace = Nothing
　　Set MyMail = Nothing
End Sub

補足

詳しいコードを記述くださりありがとうございます。

さっそく実行させてみたところ、キチンと動作しました。
最後送付実行が手作業な所も、目で確認出来るのでとてもいいですね。

ですが、やはりお客様あてにお送りする内容なので
罫線などの書式がないと納得してもらえません。
メールの本文に図を貼り付けることは無理なのですか・・・。

普段の作業（ツールバーから、電子メールボタンで「シートを本文として送付」）
も、マクロを組むのは無理なのでしょうか？

もう少し足掻いてみます。
もし、何かいいアイデアがございましたら
どうか教えて下さい。
よろしくお願い致します。

回答No.1

TTak

FollowHyperlink メソッドで、Address の値にbodyまで全部放り込んでみてはいかがでしょう。ただし、改行などは継承されないかもしれません。一応、VBAの例を示しますが、当方 OutlookExpress　のみ動作確認しました。Outlookではどうなるかちょっと判りませんので、適宜変更してみてください。

Sub TEXT_SEND_MAIL()
Dim MyData As DataObject
Dim maleTo As String
Dim ccTo As String
Dim bccTo As String
Dim mySubject As String
Set MyData = New DataObject

maleTo = "aaa@aa.ne.jp"
ccTo = "bbb@bb.ne.jp"
bccTo = "ccc@cc.ne.jp"
mySubject = "テスト"
Sheets(1).Range("A10:B20").Copy
MyData.GetFromClipboard
URL = "mailto:" & maleTo & "?Subject=" & mySubject & _
"&cc=" & ccTo & "&bcc=" & bccTo & "&body=" & MyData.GetText(1)
ActiveWorkbook.FollowHyperlink Address:=URL, NewWindow:=True
Set MyData = Nothing
End Sub

お礼

再度補足なのですが、欄がないのでお礼欄をお借りします。

ユーザーフォームを設定したところ、ちゃんと起動しました。
ありがとうございます。
ただ、やはりTTakさまの仰るように改行は継承できませんでした。

送信したいデータは表を含めたもので
できればビジュアル的に「そのまま」に近い状態で送りたいのです。

たとえば、テキストとして貼り付けるのではなく
図として貼り付ける方法を模索しております。

もし、何かいいアイデアがございましたら、どうかもう一度ご教示願えませんか？

よろしくお願い致します。

補足

さっそくの回答ありがとうございます。

宛先アドレスを自分のフリーアドレスに変えて試してみたのですが
コンパイルエラー「ユーザー定義型は定義されていません」とメッセージがでました。

参照設定で何かにチェックが入っていないのが原因でしょうか？
駆け出しで無謀な挑戦とは思っておりますが、
もう一度、解決策を教えていただけないでしょうか？
どうぞよろしくお願い致します。