職場等でOutlookを使う際、
転送メールを添付メッセージにしてくる場合があります。
1回程度なら、マニュアルで操作しますが、
日に何度もだと嫌ですよね。
そんな方向けには、下記のVBAをOutlookに仕込み
振り分け設定で使用すると便利ですよ。
詳しい使い方はまた後日・・・・
' 添付ファイルの保存を行うサブ プロシージャ
Public Sub SaveAttachedMsg (obj_Msg As MailItem)
Const SAVE_PATH = "C:\TEMP\Outlook\Attached"
Dim var_obj_FSO As Object ' FileSystemObject
Dim var_obj_Attach As Attachment
Dim var_str_FileName As String
Dim num As Integer: num = 1
Set var_obj_FSO = CreateObject("Scripting.FileSystemObject")
For Each var_obj_Attach In obj_Msg.Attachments
With var_obj_Attach
var_str_FileName = SAVE_PATH & var_obj_Attach.FileName
While var_obj_FSO.FileExists(var_str_FileName)
var_str_FileName = SAVE_PATH & Left(.FileName, InStrRev(.FileName, ".") - 1) & "-" & num & Mid(.FileName, InStrRev(.FileName, "."))
num = num + 1
Wend
.SaveAsFile var_str_FileName
End With
Next
Set obj_Msg = Nothing
Set var_obj_FSO = Nothing
End Sub
