VBSでメール内容を指定のエクセルシートに書き出し

質問

VBSで以下のようなことがしたいです。

Outlookから指定のメールを自分で選び
そのメールをドラックします。
そのメールをVBSにドロップすると
指定のエクセルシート（ここでは仮にデスクトップにあるTEST.xlsm）
のSheet1に、受信の日付と時間、差出人、件名、本文を
書き出したいです。
書き出す場所は上記順番で5項目ありますのでA1、A2、・・・A5
というようにしたいです。日付と時間は同じセルでも構いません。

また投げ込んだメールに添付ファイルがある場合は
そのファイルを指定のフォルダに保存したいです（ここでは仮にデスクトップのファイル保存　というファルダ）

このような事が可能でしょうか。
ご検討をお願いいたします。

回答No.2

imogasi

回答ではないが（小生そこまで至らない）、個人的感想を記します。
一般のウインドウズのソフトで、Drag&Dropのしくみを、ユーザーにつかわせているソフトは、あることはある。
それで、素人が自分の考える処理に、その仕組みを取り入れたくなるのは判る。
だからと言って、この課題のレベルは、プロ（MSオフィスなどを使わせる市販ソフトを製作したり、受注したりする業者）のもので、そういう会社などだと、そういうソフトのノウハウ（どういうソフトでどう組むか）が会社としてあると思う。
しかしその処理はVBA（ＶＢＳはこれ以下）などを使うと限らず、CやC++やクラスなどの継承などの仕組やAPIを使っているかもしれず、習得や作成は難しい（指導者が必要と時間がかかる）と思う。
こんな、素人向けの課題が多い、無料の質問コーナーに、安直に質問するのはお門違いかと思う。人間だから、類推で、あれ（あの仕組）をやりたい取り入れたいというのは、いろいろ出やすいが、それまでに相当な積み上げた勉強が必要なものばかりだ。
＞ご検討をお願いいたします
というのは、質問者がやるべきことで、別方法（そういう高度のことを習得できる場所を探して、そこへ近づいていくこと）で勉強すべきということ。
それに、仮にこれでできますとコードなどを回答されても、質問者の背景・前提知識が追いつかなくて、理解できないだろう。
一脈似たところのある質問の　https://okwave.jp/qa/q3820349.html
などにあるように、エクセル（VBA）でも、D&Dは限られたコントロールの、限られたイベントとしてしか使わせてない。ましてOutLookでは十分ではなかろう。
ソフトが違えば、その連携は仕組みとして、非常にむつかしいのだ。
また、本件はオフィスソフト（エクセル・アウトルックなど）の枠を超えた世界の機能を、プログラムで左右するというもののようだ。
質問者は質問表現から、D&Dの機能が、どこに（たとえばどのObjectに)備わっていれば、それが可能かも、明確に認識していないようだ。
結論は他の方法で我慢するしかないだろう。
例えば、
ＯｕｔＬｏｏｋのメイル情報を、何かのきっかけで、エクセルやワードなどに書き出す。ＶＢＡ，ＶＢＳで可能。
必要のつどそれを開いて読む。
デスクトップに、それを開くアイコンを置くぐらいなら操作で可能だろう。

回答No.1

cse_ri2

可能か不可能かだけ答えると、可能。

VBSは、MS OfficeがインストールされているPCでは、Officeの機能をだいたい呼び出せます。

具体的なコードは、調べるのが面倒なのでご自分で検索して下さい。
まあ、ググればどこかのサイトで見つかると思います。

補足

ご回答ありがとうございます。
以下は参考で見つけたコードです。
下記コードはoutlookで選択しているメールに対して行う処理ですが
これを、ドラッグアンドドロップしたメールに対して処理が行えれば
希望の処理が出来そうなのですが、どこをどう変えたらよいかわかりません。
よろしければご教示お願い致します。

Option Explicit

Dim objOA, objSelection, objOLFolder, objItm, objWS, objStm, objStm2
Dim I, Mystring, MyYesNo

Mystring = "受信日時" & vbCrLf & "件名" & vbCrLf & "送信者"& vbCrLf & "本文" & vbCrLf

Set objOA = CreateObject("Outlook.Application")

Set objSelection = objOA.ActiveExplorer.Selection
If objSelection.Count = 0 Then
MsgBox "メールが選択されていません。"
WScript.Quit
Else
MyYesNo = MsgBox(objSelection.Count & " 通のメールが選択されています。続けますか？", vbYesNo)
If MyYesNo = vbNo Then
WScript.Quit
End If
End If

Err.clear
On Error Resume Next

For I = 1 To objSelection.Count
set objItm = objSelection.Item(I)

Mystring = Mystring & vbtab & objItm.ReceivedTime & vbCrLf & objItm.Subject & vbCrLf & objItm.Sender & vbCrLf & """" & Replace(objItm.Body, """", "”") & """" & vbCrLf

Next

On Error Goto 0

Set objStm = CreateObject("ADODB.Stream")
objStm.Type = 2
objStm.Open
objStm.Charset = "UTF-16"
objStm.WriteText Mystring

Set objStm2 = CreateObject("ADODB.Stream")
objStm2.Type = 2
objStm2.Open
objStm2.Charset = "Shift-JIS"

objStm.Position = 0
objStm.CopyTo objStm2
objStm2.Position = 0
Mystring = objStm2.ReadText

objStm.Close
objStm2.Close

Mystring = Replace(Mystring,"?" & vbCrLf & vbCrLf, vbCrLf)
Mystring = Replace(Mystring,vbCrLf & "?" & vbCrLf, vbCrLf)
Mystring = Replace(Mystring,vbCrLf & vbCrLf, vbCrLf)

Set objWS = CreateObject("WScript.Shell")
objWS.Exec("clip").StdIn.Write Mystring