[Tips] Outlook VBA 添付ファイルの自動保存

職場等で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