【VBA備忘録】受信したメールから添付ファイルを保存する（Outlook編）

2023年4月28日2024年3月6日

受信したメールから添付ファイルを保存したい…！

私の毎日のルーティーンで受信したメールの添付ファイルをサーバーに保存するものがあります。
1日数十件もあると大変でとにかく面倒くさい…
こんな仕事は早々にパスしたいので、OutlookのVBAに挑戦してみました。

https://indoor-nekura.work/vba_button_color/

他にもVBAのやり方あり〼

前提条件

・添付ファイルを保存したいメールは指定のフォルダ（未処理フォルダ）に入るよう仕分けルールを設定しておく
（今回はメールの件名に共通の文字が入っているのでそこで仕分けれるようにしてあります）
・「未処理フォルダ」の中に「処理済みフォルダがある」

・受信時間を添付ファイル名の前に入れたい（yyyy-mm-dd-hhmmss(添付ファイル名)

未処理フォルダのメールに添付されたファイルを保存するマクロ

Outlook Alt+F11でVBAを開き右クリック→挿入→標準モジュールを作成
以下のプログラムを入力します

Sub 添付ファイルを指定フォルダに保存する()

Dim path As String
Dim i As Integer
Dim objfld As Object, objbox As Object, mlitem As Object
Dim tdy As String, SaveDir As String, rctime As String, temp As String
Dim zumifld As Folder

'事前処理=============================================
'保存先フォルダがあるか確認
'今日の日付のフォルダーに保存します
tdy = Format(Date, "yyyymmdd") & "\"
SaveDir = "C:\Users\Shironeco" '←保存場所
path = SaveDir & "\" & tdy
'フォルダがなかったら作成
If Dir(path, vbDirectory) = "" Then
    MkDir path
End If

'各オブジェクトをセットする
'対象のメールが届くフォルダを指定します
Set objbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) '受信フォルダ
Set objfld = objbox.Folders.item("未処理フォルダ")
Set zumifld = objfld.Folders.item("処理済みフォルダ")
'======================================================


'未処理フォルダの中にあるメールをループして処理する
For i = objfld.Items.Count To 1 Step -1

    'メールを取得
    Set mlitem = objfld.Items(i)

    'メールの受信時間を取得
    '件名を取得したい場合はReceivedTime→Subject
    '受信時間を「yyyy-mm-dd-hhmmss」表示にする
    rctime = Format(mlitem.ReceivedTime, "yyyy-mm-dd-hhmmss")
    
    '添付ファイルの保存先（ファイル名はyyyy-mm-dd-hhmmss(元のファイル名))
    temp = path & rctime & mlitem.Attachments.item(1)
    
    '添付ファイルを保存する
    mlitem.Attachments.item(1).SaveAsFile temp
    
    '処理済みフォルダにメールを移動
    mlitem.Move zumifld

Next i

End Sub

各変数に格納された内容

マクロを実行する

開発→マクロから対象のマクロを選択します。

リボンに追加しても簡単に実行できますよ！

ちゃんとマクロが実行しているのか不安な方はEnd Subの前に

MsgBox "処理が終わりました"
Shell "explorer " & temp, vbNormalFocus

を追加しておくと処理が終わったお知らせと、

保存したフォルダが立ち上がるので
ちゃんと保存できているか確認できます。

リボンに追加すればより使いやすい

リボンへの追加方法は↓のページを参考にどうぞ！

https://indoor-nekura.work/vba_ribbon/