こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

回答受付中の質問

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

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

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

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

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

投稿日時 - 2019-09-12 12:46:31

QNo.9656021

すぐに回答ほしいです

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

ANo.1

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

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

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

投稿日時 - 2019-09-12 13:12:56

補足

ご回答ありがとうございます。
以下は参考で見つけたコードです。
下記コードは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

投稿日時 - 2019-09-12 20:25:11

あなたにオススメの質問