エクセルからメール送信

質問

エクセル2000　Outlook2000です。

エクセルでメールを送信する段階までは以下のコードできるのですが、このマクロで生成されたメールを、送信前にメッセージファイル（*msg）として保存することは出来ないものでしょうか？
VBAでも手動でもかまいません。

Sub test01()

If Application.MailSystem <> xlMAPI Then
MsgBox "この機能を使用するためには MAPI対応のメーラーが必要です。", vbCritical
Else
ActiveSheet.Copy After:=Sheets(Sheets.Count)
Set ns = ActiveSheet
With ns
.DrawingObjects.Delete
.Cells.Validation.Delete
End With

SendKeys "%FDM", True
End If

End Sub

回答No.6

Wendy02 · ベストアンサー

こんにちは。

>ただ、エクセルでメニューの「ファイル」→「送信」→「メールのあて先」で作成したメールは、送信する前は送信フォルダにも下書きフォルダにも入らないようなので

それは、そういう設定が、Outlook 側でされていますね。送信フォルダにいれずに、送信したら、保存フォルダ(？）に入るようになっているのだと思います。

以下は、Excel用ですが、コード的には簡単です。

私は、送信フォルダに入れるようにしてあるので、その設定だけは、今のところ、いじりたくないのですが、そうすると、使い方が、こちらではややこしいですね。オートメーション・オブジェクトに入っているので、Outlook側のイベントは動いてはいないのですが、Outlook側を起動すると、以下のマクロが起動します。こちらがイメージしていたものとはだいぶ違いました。(Outlook 2003 で試験中）

　　myPath = Application.DefaultFilePath & "\"
このApplication は、Excelですから、Excel側のフォルダに保存されます。

どちらかというと、設定を変えたほうが早い気がしますが。

'-----------------------------
'標準モジュール
Public MyClass As New Class1
Sub Auto_Open()
　　Set myOlApp = CreateObject("Outlook.Application") 'New Outlook.Applicatn
　　Set MyClass.myOlApp = myOlApp
End Sub

'-----------------------------
'Class モジュール(Class1)
Public WithEvents myOlApp As Outlook.Application

Private Sub myOlApp_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim prompt As String
Dim myPath As String
　　myPath = Application.DefaultFilePath & "\"
　　prompt = Item.Subject & "を保存しますか?"
　　If MsgBox(prompt, vbYesNo + vbQuestion, "メール保存") = vbNo Then
　　　　Item.SaveAs myPath & strName & ".msg", 3
　　　　'Cancel = True　'これを外すと送信されない(ハズですが）
　　End If
End Sub

お礼

ありがとうございました。
せっかくご指導いただきましたが、もうわたしの理解を超えてしまいました。

みのほど知らずの質問をしてしまったと後悔しております。

出直します。
教えていただいたのにすみませんでした。

回答No.5

Wendy02

こんにちは。

>何度みても個人用フォルダ"に、送信トレイや受信トレイはありません。

それは、私の書いた文章が不十分だったと思います。
「"個人用フォルダ"」の名称の代わりに、ご自身の「ID]が入っている」わけですね。

>わたしのIDで立ち上げると「受信トレイ」や「送信済みアイテム」、「下書き」の各フォルダの中にあるメールを見ることが出来ます。

というなら、その「ID」のフォルダの中に、[送信トレイ]もあるはずです。

例：
Set MyFolder = MyNMSpace.Folders("個人ID").Folders("送信トレイ")

しかし、「送信トレイ」に入れる習慣がないのなら、#4で示したOutlookのオプションの設定を変えて「送信トレイ」に入れて、その後をマクロで、[送信実行]というコードを書かないといけないことになります。しかし、それだったら、送信トレイではなく、送信済みトレイから取り出しても同じですよね。話を分かっていただけるかしらね……。

お礼

大変お手数をおかけしました。
Set MyFolder = MyNMSpace.Folders("個人ID").Folders("送信トレイ")
を
Set MyFolder = MyNMSpace.Folders("Mailbox - Xxxx, Yyyy(名前です)").Folders("送信トレイ")
にかえたところ　Sub Test02()　では「送信トレイにメールはありません」となりました。

Sub Test03()ではエラーになりませんが.msgファイルは作成されませんでした。（送信トレイにメールがないのだから当然ですが）
ためしにFolders("送信トレイ")をFolders("削除済みアイテム")に変えて実行したらMyDocumentフォルダに.msgファイルがいっぱいできました。

ただ、エクセルでメニューの「ファイル」→「送信」→「メールのあて先」で作成したメールは、送信する前は送信フォルダにも下書きフォルダにも入らないようなので送信前に（送信しなくとも）メッセージファイルとして保存することは出来ずにいます。これはどうしようもないのでしょうか？

回答No.4

Wendy02

こんばんは。

>SendKeys "%FDM", True　でも、これで作成したメールは送信する前は下書きフォルダには入らないようです。

Outlook 側からでなければ、下書きフォルダには、いずれにしても入らないと思います。

Outlook のツールのオプションの設定で、

メール配信－メールアカウント・オプション

　[レ]接続後直ちにメッセージを送信する

とかしてあったら、たぶん、[送信トレイ]にも入っていないので、送信後の保存用フォルダを探すしかありません。

>Outlook Today -[Mailbox-○○○（名前）]からぶら下がっているように見えます。

Outlook Today は関係ありません。親フォルダですから、ここが、MyNMSpace.Folders　のことです。その下にあるはずですから、そこをローカルウィンドウ等で探して指定すればよいはずです。

Test03 のプロシージャ

Set TestFolders = MyNMSpace.Folders　'※臨時コード
Stop '※臨時コード
Set MyFolder = MyNMSpace.Folders("個人用フォルダ").Folders("送信トレイ")

'　※そのTestFoldersの内容が、どうなっているかだと思いますね。
'たぶん、"個人用フォルダ"　に、[名前]が入っているのでは？
'そのオブジェクトの下に、Folders があり、その中に、[送信トレイ]自体はあるはずです。

お礼

何度もすみません。
今日、会社で以下のコードをためしました。

Set TestFolders = MyNMSpace.Folders '※臨時コード
Stop '※臨時コード
Set MyFolder = MyNMSpace.Folders("個人用フォルダ").Folders("送信トレイ")

Stop '※臨時コード　で止まり、黄色くなります。
そのときローカルウィンドウでは
MyFolderの値はNothing
TestFoldersの値は何も表示されていませんでした。

> たぶん、"個人用フォルダ"　に、[名前]が入っているのでは？
>'そのオブジェクトの下に、Folders があり、その中に、[送信トレイ]自体はあるはずです。

何度みても個人用フォルダ"に、送信トレイや受信トレイはありません。
会社のイントラにつながっており、他のパソコンでもわたしのIDで立ち上げると「受信トレイ」や「送信済みアイテム」、「下書き」の各フォルダの中にあるメールを見ることが出来ます。（個人用フォルダは見られません）

回答No.3

Wendy02

こんばんは。

>Set MyFolder = MyNMSpace.Folders("個人用フォルダ").Folders("送信トレイ")

この名前は、規定の名前です。私は、Microsoft 系のメーラーは基本的には使っておりませんので、細かい部分は良く分かりません。そのままの状態になっています。こちらでは、送信前に、"個人用フォルダ"の　"送信トレイ"　に納まっているので、そうしているだけですから、そちらのOutlookの実態に合わせて名称を変えてください。ただし、実際のメールが一時保管される場所です。

もちろん、ローカルウィンドウで調べていただいてもよいと思います。

>メッセージファイル（*msg）は、 Outlookの「名前を付けて保存」で、「メッセージファイル」を選択して保存すると作成される、1通のメール形式のファイルです。拡張子が.msgです。

そういう意味でしたか。

>送信前にメッセージファイル（*msg）として保存することは出来ないものでしょうか？

それは、以下のようにすれば可能だと思います。

'------------------------------------------

Sub Test03()
　　Dim msg As String
　　Dim MyOl As Object 'Outlook.Application
　　Dim MyNMSpace As Object 'Namespace
　　Dim MyMail As Object 'MailItem
　　Dim MyFolder As Object 'MAPIFolder
　　Dim myPath As String
　　Dim strName As String
　　Dim i As Long
　　Dim j As Variant

　　Set MyOl = CreateObject("Outlook.Application") 'New Outlook.Application
　　Set MyNMSpace = MyOl.GetNamespace("MAPI")
　　Set MyMail = MyOl.CreateItem(0)

　　'パスの設定は、適宜に決めてください。
　　myPath = Application.DefaultFilePath & "\"
　　Set MyFolder = MyNMSpace.Folders("個人用フォルダ").Folders("送信トレイ")

　　For i = 1 To MyFolder.Items.Count
　　　　With MyFolder.Items(i)
　　　　　strName = Format$(Date, "yymmdd")
　　　　　Do: j = j + 1: Loop While Dir(myPath & strName & j & ".msg") <> ""
　　　　 .SaveAs myPath & strName & j & ".msg", 3 ''olMSG=3, olTXT =0
　　　　End With
　　Next i
　　Set MyFolder = Nothing
　　Set MyMail = Nothing
　　Set MyNMSpace = Nothing
　　Set MyOl = Nothing
End Sub

お礼

大変有難うございます。
ここまで丁寧にお教えいただいたのに、わたしは自分の送信トレイがどこにあるかを取得できないでいます。
Outlookの画面でみると、個人用フォルダよりももっと上の
Outlook Today -[Mailbox-○○○（名前）]からぶら下がっているように見えます。

Outlookで作成したメールは送信前は「下書き」というフォルダに入ります。これもOutlook Today -[Mailbox-○○○（名前）]からぶら下がっているように見えます。

ただ、エクセルで手動でファイル→送信→メールのあて先　でも
SendKeys "%FDM", True　でも、これで作成したメールは送信する前は下書きフォルダには入らないようです。

回答No.2

Wendy02

こんにちは。

>おそわったコードをそのまま使っているのです。
一応、前のログは読みました。ざっと読んだので、それについては、いきさつが見えてこないのです。
KenKen_SPさんの最初に書いた、SendMailのコードで良いと思いましたが。

>「UWSC」ってフリーウェアでしょうか？
二種類あります。シェアウェアとフリーソフトウェアとです。

本が出ています。一例で、他にもあります。

http://seshop.com/detail.asp?pid=6462
Windows マクロテクニック

「UWSC」は、一応、その業界では認められたツールです。

>会社の端末なので指定外のソフトは導入できないのです。

たぶん、会社の基準としては、常識的に、CA局証明付きだと思いますが、それは、そちらのご事情ですから、分かりませんし、「UWSC」は、フリー版しかみておりませんので、シェアウェアの扱いを、製作者側が、どの管理にしているか知りませんが、期待は出来ません。これは、あくまでも、こちらの一案です。

「UWSC」をあえて使わなくてはならないということではなくて、そうでないと、それ以外の方法は思いつかないということです。簡単な方法があるのに、それをあえて避けて作るだけの、こちらの余裕がありません。

なお、お分かりになっておっしゃっているとは思いますが、参照設定がそのままになっていましたから、

>Set MyOl = New Outlook.Application　'CreateObject("Outlook.Application")

ここは、

Set MyOl =CreateObject("Outlook.Application")

です。

>質問にも書きましたが、送信前にメッセージファイル（*msg）として保存したいのです

msg という意味が、どのようなファイル形態なのか分かりませんが、コードは、送信前です。

文字列変数　msg は、あるので、それをどのように処理するかは、ご自由です。それを、MsgBox msg で出してもよいです。保存するなら、拡張子のない、[日付]msg でも、それは選択の自由ですが、開けるときに、拡張子がなければ、Windows が聞いてくるかと、とは思います。(今は、ファイル保存は、上書きモードです）

>まだ送信されては困るのです。
>そのような方法はないものでしょうか？

それは、OutLook の設定の問題ですから、ワンクリックで送信してしまう、ということになれば、そういう方法で、ActiveX のハッキングは無理です。

なお、私のマクロは、[送信]をクリックしても、OutLook で、そのまま送信しないような設定になっていることが条件です。

いずれにしても、今のスタイルでは、結果的に、セキュリティのダイアログが出てくるので、最初から、SendMail を使っても同じことだと思います。

こちらが、宛先もタイトルと日付も取得することを、考慮して気を回しただけですから、データだけでよいなら、シートをTextFile で出力するだけでもよいと思います。それを、もう一度、吸い上げて、MsgBox に出してもよいと思います。

お礼

何度もありがとうございます。

Set MyOl =CreateObject("Outlook.Application")　としたところ作動しましたが、
Set MyFolder = MyNMSpace.Folders("個人用フォルダ").Folders("送信トレイ")　が「操作は失敗しました。オブジェクトが見つかりませんでした」というエラーになってしまいました。

エクセルVBAがおぼつかないのにメールまで手をだすのが早すぎたようです。
メッセージファイル（*msg）は、 Outlookの「名前を付けて保存」で、「メッセージファイル」を選択して保存すると作成される、1通のメール形式のファイルです。拡張子が.msgです。

回答No.1

Wendy02

こんばんは。

その質問のコードには、それなりに、前からのいきさつがあるだろうから、そこについては触れませんが、ふつうなら、Sendkeys で、そのような操作をせずに、最初から、Sendmail を使っているだろうし、ある程度の経験があれば、Basp21 を選ぶだろうと思います。

OutLook なら、OutLook 側から、イベントで捕らえる方法もあるうのですが、あくまでも、Excel側からのアプローチにしてあります。わざわざ、MAPIのチェックまでしておいて、途中から、Sendkeys に変えたわけですから、そのようなスタイルだと、最初から最後まで、「UWSC」 でアプリを操作をしたほうが楽かもしれない、と思います。

http://www.uwsc.info/

このコードは、APIを使うレベルのものをより簡単に書けます。
常識的なマクロを書ける人なら、誰でもわかるものだと思います。

なお、以下のコードでは、今回、OutLook 2000 では試しておりません。

それに、MAPI のOutLook では、セキュリティが働いてしまうので、途中でダイアログが出てしまい、確認のためのマウス・クリックが必要になって、UWSC のように、別アプリからの擬似キーストロークによるクリック操作が必要になってしまいます。最初から、無理は承知で書いています。

以下では、OutLookの"送信トレイ"を探しています。

参考までにしてください。

これは、「送信する段階」というか、Excel上で送信した後に、OutLook の送信フォルダ内を調べるものです。
フォルダを変えれば、送信済みも調べられますが、その場合は、For i = 1 to ～　ではなく、MailItems(1) だけでよいと思います。

'---------------------------------

Sub Test02()
　　Dim msg As String
　　Dim MyOl As Object 'Outlook.Application
　　Dim MyNMSpace As Object 'Namespace
　　Dim MyMail As Object 'MailItem
　　Dim MyFolder As Object 'MAPIFolder
　　Dim objText As Object
　　Dim i As Integer
　　Dim y As Variant, m As Variant, d As Variant

　　Set MyOl = New Outlook.Application 'CreateObject("Outlook.Application")
　　Set MyNMSpace = MyOl.GetNamespace("MAPI")
　　Set MyMail = MyOl.CreateItem(0)

　　Set MyFolder = MyNMSpace.Folders("個人用フォルダ").Folders("送信トレイ")

　　For i = 1 To MyFolder.Items.Count
　　　　With MyFolder.Items(i)
　　　　　　msg = .To
　　　　　　msg = msg & vbNewLine & .Subject
　　　　　　y = Year(.CreationTime)
　　　　　　m = Month(.CreationTime)
　　　　　　d = Day(.CreationTime)
　　　　　　msg = msg & vbNewLine & y & "/" & m & "/" & d
　　　　　　msg = msg & String(2, vbNewLine) & .Body 'メール・アイテムは一つということにしている
　　　　End With
　　Next i
　　Set MyFolder = Nothing
　　Set MyMail = Nothing
　　Set MyNMSpace = Nothing
　　Set MyOl = Nothing
　　If Trim(msg) = "" Then
　　　　MsgBox "送信トレイにメールはありません。", 48
　　　　Exit Sub
　　End If
　　With CreateObject("Scripting.FileSystemObject")
　　　　Set objText = .CreateTextFile(Application.DefaultFilePath & "\msg.txt")
　　　　objText.Write msg
　　　　objText.Close
　　End With
　　MsgBox "msg.txtファイルを出力しました。"
End Sub

お礼

Wendy02さま、いつもありがとうございます。

> ふつうなら、Sendkeys で、そのような操作をせずに、最初から、Sendmail を使っているだろうし

おそわったコードをそのまま使っているのです。

「UWSC」ってフリーウェアでしょうか？
会社の端末なので指定外のソフトは導入できないのです。

ご教示のコードを、会社のWindos2000、Excel2000で試しましたが、 Set MyOl = New Outlook.Application　の部分で「コンパイルエラー　ユーザー定義型はていぎされていません」となってしまいます。

> これは、「送信する段階」というか、Excel上で送信した後に、OutLook の送信フォルダ内を調べるものです。

質問にも書きましたが、送信前にメッセージファイル（*msg）として保存したいのです。
まだ送信されては困るのです。
そのような方法はないものでしょうか？