※WinActor v6.3.0／Outlook2016環境で確認※

お世話になっております。

時折、Outlookの受信メールの保存に関する質問を目にします。

Outlook 条件を指定して対象メール保存について

保存した際に20210323_1630_00001といったフォルダが作成されてその中に保存したファイルがあります。
それに関して、フォルダをなくしてファイルのみで保存できるようにしたいですが....

【VBA】アウトルックの添付ファイルのうちZIPファイルのみ保存しEXCELに書き出す

フォルダー内のメールのうちZIPファイルのみを指定し保存、EXCELに書き出したいと思います。....

Outlook 特定フォルダで受信したメールの添付ファイルをすべて保存

メールそのものではなく、メールについている添付ファイルのみを保存したい....

20_メール関連＞01_Outlook操作の中の、

「Outlook 条件を指定して対象メール保存.ums6」

ライブラリを使うことで、メールや添付ファイルを保存することができます。

絞り込み項目が複数あって戸惑うかもしれませんが、検索条件を指定しなければ

「検索対象フォルダ」で指定したメール上フォルダの中にあるすべてのメールが対象になります。

ただし、上記質問のように、メール受信日時ごとに生成されてしまうサブフォルダが不要だったり、

特定の添付ファイルのみ保存対象にしたい、という場合もあると思います。

スクリプトの編集が業務上の規定などで難しい場合は、

「Outlook 条件を指定して対象メール保存.ums6」をそのまま実行してすべてのファイルを保存した後、

他のライブラリやコマンド実行などを組み合わせて、必要な状態に持っていくのが望ましいです。

でも、ライブラリ一発で済めば楽なのになあ…と思うことはあるので、

「Outlook 条件を指定して対象メール保存.ums6」をベースに下記の機能を追加してみました。

• メール保存先設定：
  • メールごとにサブフォルダを作成、ファイル保存先にそのまま保存を選べる
• 保存対象：
  • メールと添付ファイル両方保存、メールのみ保存、添付ファイルのみ保存を選べる
• 添付ファイルの拡張子指定：
  • 添付ファイルのうち、特定の拡張子のファイルだけ保存したい場合に拡張子を指定できる（複数可）

以下、ライブラリの修正箇所です。

修正箇所①：スクリプト上部のプロパティ設定箇所

splitChr = !区切り文字|\,/,#,$,%!

sSUb = !件名!

　　↓

splitChr = !区切り文字|\,/,#,$,%!

'----------------------記述追加
sSaveFolderSelect = !メール保存先設定|メールごとにサブフォルダを作成,ファイル保存先にそのまま保存!
sSaveItemSelect = !保存対象|メールと添付ファイル両方,メールのみ,添付ファイルのみ!
sSaveExtensionName = !添付ファイルの拡張子指定!

If sSaveExtensionName <> "" Then
sSaveExtensionName = Replace(sSaveExtensionName, ".", "")
sSaveExtensionName = Replace(sSaveExtensionName, ",", "|")
sSaveExtensionName = Replace(sSaveExtensionName, splitChr, "|")
sSaveExtensionName = "\.(" & sSaveExtensionName & ")$"
Else
sSaveExtensionName = ".*"
End If

' 末尾の拡張子が一致するか（文字列全体を対象、大文字小文字の区別なし）
Set oRE = Nothing
Set oRE = CreateObject("VBScript.RegExp")
oRE.Pattern = sSaveExtensionName
oRE.Global = true
oRE.IgnoreCase = true
'----------------------

sSUb = !件名!

修正箇所②：メール保存先フォルダを作成するプロシージャ（Function MakeSavePath）

Dim iDirNum

iDirNum = 1

　　↓

Dim iDirNum

'----------------------記述追加
' メール保存先を「ファイル保存先」にそのまま格納する場合はフォルダを作成しない
If sSaveFolderSelect = "ファイル保存先にそのまま保存" Then
     MakeSavePath = sBasePath
     Exit Function
End If
'----------------------

iDirNum = 1

修正箇所③、④：メールと添付ファイルを保存するプロシージャ（Sub SaveMailAndFile）

On Error Resume Next
oMail.SaveAs sMsgFileName, olMSG
If Err.Number <> 0 Then
     On Error GoTo 0
     Err.Raise 1, "", "メールの保存に失敗しました。" & vbCrLf & "[" & sMsgFileName & "]"
     WScript.Quit()
End If

On Error GoTo 0

　　↓

On Error Resume Next

'----------------------記述追加
' 保存対象が「添付ファイルのみ」ではないときのみメールファイルを保存する
If sSaveItemSelect <> "添付ファイルのみ" Then
     oMail.SaveAs sMsgFileName, olMSG
End If
'----------------------
If Err.Number <> 0 Then
     On Error GoTo 0
     Err.Raise 1, "", "メールの保存に失敗しました。" & vbCrLf & "[" & sMsgFileName & "]"
     WScript.Quit()
End If

'----------------------記述追加
' 保存対象が「メールのみ」の場合は添付ファイルの保存はせずに終了する
If sSaveItemSelect = "メールのみ" Or oAttachments.Count = 0 Then
     Exit Sub
End If
'----------------------
On Error GoTo 0

On Error Resume Next
oAttachments(i).SaveAsFile (sSavePath & "\" & oAttachments(i).FileName)
If Err.Number <> 0 Then

　　↓

On Error Resume Next

'----------------------記述追加
' 拡張子が指定されている場合は、それに一致するファイルのみ保存する
If oRE.Test(oAttachments(i).FileName) Then
     oAttachments(i).SaveAsFile (sSavePath & "\" & oAttachments(i).FileName)
End If
'----------------------
If Err.Number <> 0 Then

使い方の例：

「taro_tanaka@hogehoge.co.jp」の「受信トレイ」にあるすべてのメールに対して、
添付されている「xlsx」ファイルもしくは「csv」ファイルのみを、
「C:\メール添付ファイル\データファイル一覧」フォルダに保存する。

ファイル保存先「値⇒C:\メール添付ファイル\データファイル一覧」
検索対象フォルダ「taro_tanaka@hogehoge.co.jp\受信トレイ」
区切り文字「\」
メール保存先設定「ファイル保存先にそのまま保存」
保存対象「添付ファイルのみ」
添付ファイルの拡張子指定「xlsx,csv」 ※複数指定する場合は半角カンマ「,」で区切る
件名「値⇒」　※フォルダ内全メールが対象なので指定せず
本文「値⇒」　※〃
差出人「値⇒」※〃
宛先「値⇒」　※〃
受信日時「」　※〃
送信日時「」　※〃
添付ファイル有無「」※〃
保存上限件数「値⇒100」　※設定しないといけないので、適当な数字を指定
検索件数「dummy」　※使用しない場合は適当にダミーの変数を指定
保存件数「dummy」　※〃

これを実行すると、「受信トレイ」にあるメールのうち、

添付ファイルの拡張子が「xlsx」または「csv」のファイルだけが、

「C:\メール添付ファイル\データファイル一覧」に保存されます。

ただ、あんまりひとつのライブラリに項目を追加しても見づらいので、

「指定フォルダのメールのうち、指定した拡張子の添付ファイルを保存」

「指定フォルダのメールを指定先に一律保存」

のような、動作を絞ったライブラリが複数あった方が助かるのかもしれません。

シナリオ上でもわかりやすいです。

以上、もし公式でOutlook関連ライブラリの機能が拡張されたら嬉しいな、というコラムでした。

参考になれば幸いです。