【VBA】Outlook 添付ファイルをフォルダに保存する

Outlookでメールに添付されたファイルをフォルダに保存するVBAを紹介します。

Outlookのメールに添付されたファイルを一つずつ保存していくのってけっこう面倒くさいんですよね。

このVBAを使えば大量のファイルも数秒で終了しますよ。

そんな夢のようなアイテムがあるんですか！？

内容は難しいですが、コピペして使えますので、便利ですよ。

Outlookでメールに添付されたファイルを保存するVBA

保存したいファイルが添付されているメールをOutlook内の特定のフォルダに保存します。

VBAを利用する前段階として、
Microsoft Visual Basic for Applicationsを開き(Alt + F11)、
ツールの参照設定で、Microsoft Outlook XX Object Libraryにチェックを入れる。

保存先フォルダを固定する場合

メールに添付されたファイルを保存する（保存先固定）VBA

Sub フォルダ内の添付ファイルを一括保存()

    Dim olapp As Outlook.Application
    Dim olexp As Outlook.Explorer
    Dim olsel As Outlook.Selection
    Dim attFile As Object
    Dim fpath As String
    Dim pos As Long

    On Error GoTo ErrHandler
    Set olapp = CreateObject(“Outlook.Application”)
    Set olexp = olapp.ActiveExplorer

    MsgBox “Outlook内のフォルダを選択してください”

    Set olsel = olexp.Selection

    fpath = “ファイルパス名\”

    Dim olns As Namespace
    Dim olmf As MAPIFolder
    Dim x As Long

    Set olns = GetNamespace(“MAPI”)
    Set olmf = olns.Application.ActiveExplorer.CurrentFolder

    For x = 1 To olmf.Items.Count
        For Each attFile In olmf.Items(x).Attachments
            pos = InStrRev(attFile.DisplayName, “.”)
            If pos > 0 Then
                attFile.SaveAsFile fpath & attFile.DisplayName
            End If
        Next attFile
    Next

    MsgBox “終了しました。”, vbOKOnly + vbInformation, “添付ファイル一括保存”
    GoTo ExitP

ErrHandler:
    MsgBox “エラーが発生しました” & vbCrLf & Err.Description, vbExclamation, “添付ファイル一括保存”

ExitP:
    Set olapp = Nothing
    Set olexp = Nothing
    Set olsel = Nothing
    Set attFile = Nothing
    Set olns = Nothing
    Set olmf = Nothing

End Sub

すでに同じファイル名が存在する場合は、上書きされます。

解説

エラーが発生した場合、ErrHandlerにジャンプ
Outlookをインスタンス化します
それをアクティブにします

対象のOutlookフォルダが選択されているか確認メッセージを出す
※選択したOutlook内のフォルダにあるメールの添付ファイルを保存します

アクティブにしているOutlookを選択します

保存先のフォルダを指定します
※最後に「\」をつけること

ファイルパス名の参照方法

保存先フォルダを毎回指定する場合

メールに添付されたファイルを保存する（保存先指定）VBA

「 fpath = “ファイルパス名\” 」の部分を変更します。

保存先を指定するためのウインドウが開き、フォルダが指定できます。

    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            fpath = .SelectedItems(1) & “\”
        Else
            MsgBox “ファイルが指定されませんでした”
            Exit Sub
        End If
    End With

ファイル名の重複を避けるためのVBA

保存先フォルダにすでに同じ名前のファイルが存在する場合、上記のVBAを実行すると上書きしてしまいます。

ここではファイル名にメール受信日を追加するVBAを紹介します。

ファイル名にメール受信日を付けるVBA

For ～ Next の間を次のように変更します。

メール受信日時を取得し、ファイル名の頭に「年月日時分秒」を付けています。

        For Each attFile In olmf.Items(x).Attachments
            pos = InStrRev(attFile.DisplayName, “.”)
            RDay = Format(olmf.Items(x).ReceivedTime, “YYYYMMDDhhmmss”)

             If pos > 0 Then
                attFile.SaveAsFile fpath & RDay & attFile.DisplayName
             End If
        Next attFile