くのへスタジオ 
こんにちは、くのへ@MasazaneKunoheです。
Outlookで便利なコードを作ったと思うので公開します。
（完全版はこちら）
メール本体と添付資料を一発で保存
コードの機能はこんな感じです
① Outlookメールを開いた状態でこのマクロを起動すると、デスクトップにフォルダが作成され、その中にメール本体と添付資料が一式保存されます。
②ここで、デスクトップに作成されるフォルダ名は、ダイヤログボックスで入力するようにしています。名前を入力すると、今日の日付＋名前（入力値）のフォルダが生成されます。メールの受信日や送信日ではなく、実際にマクロを実行した日が書かれます
③メール本体の名前も②で入力した名前になります。
注意！！
メールを開いた状態にする必要があります。
受信ボックスで選択した状態だとダメです。ダブルクリックして開いてからマクロを動かしてね。
コード
コピペで動くと思います。
ただし、strPathだけは自分用に書き直してください。
私のパソコンのデスクトップアドレスを代入するため、
strPath = “C:¥Users¥user¥Desktop¥”
でstrPathにデスクトップのアドレスを代入しています。このアドレスはパソコンによってアドレスが違うはずです。
（完全版だと、ここの設定も不要です。）
Sub メール保存()
Dim objIns As Outlook.Inspector
Dim objItem As Object
Dim strName As String
Dim strPath As String
Dim objAttachment As Object
Dim objFSO As Object
Dim strFile As String
Set objIns = Application.ActiveInspector
Set objItem = objIns.CurrentItem
strPath = "C:¥Users¥user¥Desktop¥" 'ファイルを保存したい場所のアドレス。最後の¥を忘れずに
strName = InputBox("フォルダ名を記載ください", "フォルダ作成", "フォルダ名")
strName = Left(Date, 4) & Mid(Date, 6, 2) & Mid(Date, 9, 2) & "_" & strName
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CreateFolder strPath & strName
objItem.SaveAs strPath & strName & "¥" & strName & ".msg"
With objItem
For Each objAttachment In .Attachments
strFile = strPath & strName & "¥" & objAttachment
objAttachment.SaveAsFile strFile
Next objAttachment
End With
End Sub
動作の動画
さらに改善
①名前入力をキャンセルしてもフォルダが作成されてしまうのを改善
このコードは途中で名前入力をキャンセルしてもフォルダが出来ます（笑）
これは簡単に直せるんですが、コードの可読性がほんのちょっと悪くなるため、この記事ではこのバグは放置してます。
修正したものは、こちらの記事を見てください。
②受信ボックスから操作したい
今回は、開いたメールを一発保存する物です。
でも、受信ボックスで選択しているメールを操作したいよね～
これはこちらの記事を見てください。
③SetしたオブジェクトをNothingしておいたほうが良い
Setしたオブジェクト変数は最後にNothingを代入し、中身を消した方が安全です。
これも修正した記事はこちらを見てください。
④デスクトップなどの所定フォルダではなく、選択式にしたい
今回は、デスクトップに一発保存する物です。
でも、保存先を選択式にしたい人もおられると思います
この場合はこちらの記事を見てください。
ではまた別の記事で～
🦅バサバサ～
