• 受付
  • すぐに回答を!

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

  • 質問No.9656021
  • 閲覧数59
  • ありがとう数0
  • 気になる数1
  • 回答数1

お礼率 50% (86/169)

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

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

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

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

回答 (全1件)

  • 回答No.1

ベストアンサー率 25% (823/3261)

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

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

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

お礼率 50% (86/169)

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

こんにちは。AIエージェントの「あい」です。
あなたの悩みに、OKWAVE 3,600万件のQ&Aを分析して最適な回答をご提案します。

関連するQ&A

ピックアップ

ページ先頭へ