人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

マイクロソフトアウトルックの件名内容を特定フォルダにメモ帳貼付したい。【エクセルVBA】


画像のようなマイクロソフトアウトルックのメッセージを選択し、
選択したメール内容をメモ帳で保存したいのです。

・メールの件名がそのままメモ帳の件名
・メールのメッセージ内容がそのままメモ帳の中身

となります。

メールの件名は170217021補助説明など、9ケタ(2017年の下二けた17から始まる6ケタ+3桁の連番+漢字の組み合わせです。


それを下記の場所に、件名に応じて、その日付(この場合17017)というフォルダをつくって、その中のさらに下層の楽天というフォルダをつくってその中に保存したいのです。


なお、フォルダがすでに存在している場合もあります。

★保存場所などは追加説明いたします。
途中エラーがでたときには、エラーがでたので中止しました。などと言ってくれるとありがたいです。


エクセルのVBAかUWSCでお願いいたします。
(それ以外にポイントはお付けできません)
お手数ですがよろしくお願いいたします。

1485686015
●拡大する

●質問者: naranara19
●カテゴリ:コンピュータ
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

質問者から

★画像の保存場所は
C:\Users\zzzzzz\Desktop\PC移動受け\写真(現在)\170217\楽天

などになります。

zzzzzzは実際は個人名です。



★マイクロソフトアウトルックの保存場所は
C:\Users\zzzzzz\AppData\Local\Microsoft\Outlook\Outlook.pst

でした。その「自分の出品必要」というトレイになります。


1 ● a-kuma3
●500ポイント ベストアンサー

Excel VBA でという指定がありますが、Excel のファイルに保存するわけでもなく、Excel を起動する意味がないと思うので、VBScript のコードです。

base_dir = "C:\Users\zzzzzz\Desktop\PC移動受け\写真(現在)\"

Sub save_mail

 Set re = New RegExp
 re.Pattern = "^(\d{6})\d{3}"

 Set fs = CreateObject("Scripting.FileSystemObject")
 Set outlook = WScript.CreateObject("Outlook.Application")

 Set namespace = outlook.GetNamespace("MAPI")
 
 Set inbox = namespace.GetDefaultFolder(6)  ' InBox
 Set mail_folder = inbox.Folders("自分の出品必要")
 
 
 For i = 1 To mail_folder.Items.Count
 Set mail = mail_folder.Items(i)
 Set ma = re.Execute(mail.Subject)
 If ma.Count > 0 Then
 folder = ma(0).SubMatches(0)
 file = mail.Subject
 If Not fs.FolderExists(base_dir & folder) Then
 fs.CreateFolder(base_dir & folder)
 fs.CreateFolder(base_dir & folder & "\楽天")
 End If
 If Not fs.FileExists(base_dir & folder & "\楽天\" & file & ".txt") Then
 Set f = fs.CreateTextFile(base_dir & folder & "\楽天\" & file & ".txt", True)
 f.Write(mail.Body)
 f.Close
 Else
 wscript.echo "File already exists. " & file
 End If
 Else
 wscript.echo "Bad title. " & mail.Subject
 End If
 Next

' outlook.Quit ' Outlook を終了させる
 Set outlook = Nothing
 Set fs = Nothing

End Sub

call save_mail

上記のコードを、savemail.vbs というような名前で保存して、コマンドプロンプトを起動して

d> cscript savemail.vbs

という感じで実行します。
# d> は、プロンプトのつもりです。

保存先の根っこになるディレクトリを、スクリプトの先頭で書いてますので、適宜変更してください。
他にも、「楽天」というサブディレクトリ名とか、受信メールのフォルダなど埋め込みで書いているところがいくつかあります。

メールの件名が数字9ケタで始まってない場合と、既に同名のファイルが存在する場合には、コマンドプロンプトにメッセージを出して処理をスキップするようにしています。

スクリプトの最後の方に、outlook.Quit という行をコメントアウトしていますが、これを活かすと起動中の Outlook を終了させます。
普段、Outlook を起動しっぱなしにしているなら、コメントアウトしたままの方が使いやすいと思います。
逆に、Outlook は必要なときにしか起動せず、メールを確認したらすぐに閉じてしまうような使い方をしているなら、コメントを外した方が良いと思います。


naranara19さんのコメント
ありがとうございます。 スクリプトの保存先をzzzzzzの直下フォルダにして、コマンドプロンプトを起動してやってみたのですが(デスクトップと、写真(現在)にもおいてみました) C:\Users\zzzzzz\savemail.vbs(14,5) Microsoft Office Outlook: 操作は失敗しました。オブジェクトが見つかりませんでした。 となってしまいます。 ★スクリプトのファイルはメモ帳を起動して、すべてのファイルにしてsavemail.vbsで保存にしています。 どこがおかしいでしょうか?なお、アウトルックではもとの写真にあるような感じで、 170205012補助説明と、170205022補助説明のメールを選択してコマンドプロンプトで実行してみました。

a-kuma3さんのコメント
>> C:\Users\zzzzzz\savemail.vbs(14,5) Microsoft Office Outlook: 操作は失敗しました。オブジェクトが見つかりませんでした。 << 14行目というと、以下の行ですよね。 >|vb| Set mail_folder = inbox.Folders("自分の出品必要") ||< inbox が正しく取得できてないようなので、その前の行の >|vb| Set inbox = namespace.GetDefaultFolder(6) ' InBox ||< の戻り値が、きちんと取れてないっぽいです。 これ、「受信トレイ」のフォルダを取得してるんですが、最初からあるフォルダですよね? 13?14行目の間に、以下の行を追加すると、コマンドプロンプトになんて表示されますか? >|vb| Set inbox = namespace.GetDefaultFolder(6) ' InBox wscript.echo inbox.Name Set mail_folder = inbox.Folders("自分の出品必要") ||< inbox が正しく取れてると「受信トレイ」と表示されるはずで、inbox が取得できてないと、コメントにあったようなエラーが表示されるはずです。

a-kuma3さんのコメント
あ、.pst ファイルでしたね。 >|vb| Set inbox = namespace.GetDefaultFolder(6) ' InBox Set mail_folder = inbox.Folders("自分の出品必要") ||< の部分を、以下のように変えるとどうでしょうか。 >|vb| Set personal = namespace.Folders("個人用フォルダ") ' 個人用フォルダ Set inbox = personal.Folders("受信トレイ") ' 受信トレイ Set mail_folder = inbox.Folders("自分の出品必要") ||< 「フォルダ」とか「トレイ」は、半角のカナの可能性もありますので、適宜変えてください。

naranara19さんのコメント
ありがとうございます。 et personal = namespace.Folders("個人用フォルダ") ' 個人用フォルダ Set inbox = personal.Folders("受信トレイ") ' 受信トレイ Set mail_folder = inbox.Folders("自分の出品必要") に変えてやってみたのですが、同じエラーがでます。(半角、全角も変えてやってみました) プロパティで確認したのですが、自分の出品必要のプロパティを調べましたが、場所は、\\個人用フォルダ\受信トレイとなっておりました。何がいけないですかね。

a-kuma3さんのコメント
質問の画像を見直してみたら、微妙にフォルダ名を間違えてました。 >|vb| Set personal = namespace.Folders("個人用フォルダ") ' 個人用フォルダ Set inbox = personal.Folders("受信トレイ") ' 受信トレイ Set mail_folder = inbox.Folders("自分出品必要") ' 「の」を消しました ||< 「自分<span style="color:red;">の</span>出品必要」の「の」を削ってやってみてください。

naranara19さんのコメント
ありがとうございます!これはこちらで気づいていまして、「の」ははずしているのです。

a-kuma3さんのコメント
あ、そうでしたか。 Outlook2010 ですが、以下のような階層の .pst ファイルを作って試した感じでは、正しく抽出できているのですがねえ。 f:id:a-kuma3:20170206150700p:image

naranara19さんのコメント
ありがとうございます。アウトルック2007というのがいけないんでしょうかね? それと、savemail.vbsはデスクトップに作成というので大丈夫でしょうか?

a-kuma3さんのコメント
ググってみると、Outlook2003 で同じやり方で .pst ファイルに逃がしたメールをたどっていく VBA はあるので、2007 でも問題ないと思うんですけどね。 http://stackoverflow.com/questions/8041842/loop-through-psts-in-outlook-2003-with-vba http://windowssecrets.com/forums/showthread.php/108644-Using-VBA-to-move-a-message-to-a-PST-file-%28Outlook-2003%29 一応、.pst ファイルにある方のフォルダをたどっていくスクリプトの全体を載せておきます。 >|vb| base_dir = "C:\Users\zzzzzz\Desktop\PC移動受け\写真(現在)\" Sub save_mail Set re = New RegExp re.Pattern = "^(\d{6})\d{3}" Set fs = CreateObject("Scripting.FileSystemObject") Set outlook = WScript.CreateObject("Outlook.Application") Set namespace = outlook.GetNamespace("MAPI") Set personal = namespace.Folders("個人用フォルダ") ' 個人用フォルダ Set inbox = personal.Folders("受信トレイ") ' 受信トレイ Set mail_folder = inbox.Folders("自分出品必要") For i = 1 To mail_folder.Items.Count Set mail = mail_folder.Items(i) Set ma = re.Execute(mail.Subject) If ma.Count > 0 Then folder = ma(0).SubMatches(0) file = mail.Subject If Not fs.FolderExists(base_dir & folder) Then fs.CreateFolder(base_dir & folder) fs.CreateFolder(base_dir & folder & "\楽天") End If If Not fs.FileExists(base_dir & folder & "\楽天\" & file & ".txt") Then Set f = fs.CreateTextFile(base_dir & folder & "\楽天\" & file & ".txt", True) f.Write(mail.Body) f.Close Else wscript.echo "File already exists. " & file End If Else wscript.echo "Bad title. " & mail.Subject End If Next ' outlook.Quit ' Outlook を終了させる Set outlook = Nothing Set fs = Nothing End Sub ||<

naranara19さんのコメント
ありがとうございました!これ以上はご迷惑をおかけするので、一度質問を終了しますね。 また本件等ご質問させていただくときにはぜひご協力いただけたら幸いです。 いつもありがとうございます。

a-kuma3さんのコメント
うーん、もやもやします (´・ω・`)
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ