課題・悩み「Outlookのメールと添付ファイルをサクッとフォルダに保存したい」
解決策「Outlookのメールとその添付ファイルを一括で保存するVBAマクロのコード」を解説
重要なメールやメールの添付ファイルは後で見返すことも多いため、フォルダに保存して管理すると便利です。
そこでメール管理の効率を上げるために、メールとその添付ファイルをワンクリックで保存するVBAマクロのコードを作成したので、解説します。
【Outlookのメールとその添付ファイルを一括で保存するVBAマクロのコード】を解説しています。
メールや添付ファイうrはフォルダに保存すると便利
指示や内容の確認のために、何度も見返すメールや添付ファイル。
確認のたびにOutlook内を探していたら効率が悪いので、重要なメールや添付ファイルはフォルダに保存して管理するのがおすすめ。
管理方法は以下の投稿をご覧ください。
Outlookでメールと添付ファイルを保存するVBAマクロのコード
このマクロは、Outlookで選択されたメールとその添付ファイルをユーザーが指定したフォルダに保存する処理を行います。
Sub メールと添付ファイルの保存()
Dim objMail As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Dim strFolderPath As String
Dim strFileName As String
Dim i As Integer
Dim objWord As Object
Dim objDialog As Object
Dim objSelection As Outlook.Selection
' Wordアプリケーションの新しいインスタンスを生成
Set objWord = CreateObject("Word.Application")
' WordのFileDialogを使用してフォルダ選択ダイアログを表示
Set objDialog = objWord.FileDialog(4) ' msoFileDialogFolderPicker = 4
With objDialog
.Title = "保存先のフォルダを選択してください"
' 初期フォルダパスを設定（適宜変更してください）
.InitialFileName = "C:\Users\YourUserName\Documents\" ' ここを適切なパスに変更してください
If .Show = -1 Then
strFolderPath = .SelectedItems(1) & "\"
Else
MsgBox "フォルダが選択されませんでした。"
objWord.Quit
Set objWord = Nothing
Exit Sub
End If
End With
objWord.Quit
Set objWord = Nothing
' 選択されたメールアイテムを取得
Set objSelection = Application.ActiveExplorer.Selection
If objSelection.Count > 0 Then
For Each objItem In objSelection
If TypeOf objItem Is Outlook.MailItem Then
Set objMail = objItem
' メールの件名からファイル名として使用できない文字を除去
Dim validSubject As String
validSubject = ReplaceInvalidCharactersForFilename(objMail.Subject)
' メールを保存（件名をファイル名として使用）
strFileName = strFolderPath & validSubject & ".msg"
objMail.SaveAs strFileName, olMSG
' 添付ファイルを保存
Set objAttachments = objMail.Attachments
If objAttachments.Count > 0 Then
For i = 1 To objAttachments.Count
objAttachments.Item(i).SaveAsFile strFolderPath & objAttachments.Item(i).FileName
Next i
End If
End If
Next
End If
Set objMail = Nothing
Set objAttachments = Nothing
Set objSelection = Nothing
End Sub
Function ReplaceInvalidCharactersForFilename(ByVal str As String) As String
ReplaceInvalidCharactersForFilename = Replace(str, ":", "-")
ReplaceInvalidCharactersForFilename = Replace(ReplaceInvalidCharactersForFilename, "\", "-")
ReplaceInvalidCharactersForFilename = Replace(ReplaceInvalidCharactersForFilename, "/", "-")
ReplaceInvalidCharactersForFilename = Replace(ReplaceInvalidCharactersForFilename, "*", "-")
ReplaceInvalidCharactersForFilename = Replace(ReplaceInvalidCharactersForFilename, "?", "-")
ReplaceInvalidCharactersForFilename = Replace(ReplaceInvalidCharactersForFilename, """", "-")
ReplaceInvalidCharactersForFilename = Replace(ReplaceInvalidCharactersForFilename, "<", "-")
ReplaceInvalidCharactersForFilename = Replace(ReplaceInvalidCharactersForFilename, ">", "-")
ReplaceInvalidCharactersForFilename = Replace(ReplaceInvalidCharactersForFilename, "|", "-")
End Functionユーザーが保存先のフォルダを選択します。
選択されたメールを取得し、その件名をファイル名として使用してメールを保存します。
同じく、添付ファイルを保存します。
処理ごとの解説
Wordアプリケーションの起動
Wordオブジェクトを使用してフォルダ選択ダイアログを表示するためにWordアプリケーションを起動します。
Set objWord = CreateObject("Word.Application")フォルダ選択ダイアログの表示
WordのFileDialogを使用して、フォルダ選択ダイアログを表示し、ユーザーに保存先のフォルダを選択させます。
Set objDialog = objWord.FileDialog(4)With objDialog ... End Withメールアイテムの取得
Outlookの選択項目からメールアイテムを取得します。
Set objSelection = Application.ActiveExplorer.SelectionFor Each objItem In objSelection ... Nextメールの保存
メールの件名から不適切な文字を除去し、件名をファイル名として使用してメールを保存します。
strFileName = strFolderPath & validSubject & ".msg"objMail.SaveAs strFileName, olMSG添付ファイルの保存
メールに添付されているファイルを順に取得し、指定されたフォルダに保存します。
Set objAttachments = objMail.AttachmentsFor i = 1 To objAttachments.Count ... Next i注意点
データが大量にある場合、処理に時間がかかる可能性があります。
VBAマクロで実行した操作は元に戻せません。特にメールや添付ファイルの保存先を間違えた場合は、手動で元の場所に戻す必要があります。
必要な環境設定
OutlookのVBAエディタで「ツール」>「参照設定」から「Microsoft Word 16.0 Object Library」またはそれに近い名前のライブラリを参照設定に追加する必要があります。
これらの説明を参考にして、マクロの実行に必要な準備や処理の流れを理解してください。
個別環境への変更点
初期フォルダパスの設定
フォルダ選択ダイアログで最初に表示されるフォルダのパスを設定します。自分の環境に合わせてパスを変更してください。
.InitialFileName = "C:\Users\YourUserName\Documents\"参照設定の追加
OutlookのVBAエディタで「Microsoft Word 16.0 Object Library」の参照設定を追加する必要があります。この設定はコードには直接現れませんが、マクロを正常に動作させるために必要です。
（参照設定の追加はコードには直接現れません）このコードは、Outlookから選択したメールとその添付ファイルをユーザーが指定したフォルダに保存するマクロです。
Sub SaveEmailAndAttachments()
Dim objMail As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Dim strFolderPath As String
Dim strFileName As String
Dim i As Integer
Dim objExcel As Object
Dim objDialog As Object
Dim objSelection As Outlook.Selection
Dim initialFolderPath As String
' 初期フォルダパスを設定します。適宜変更してください。
initialFolderPath = "C:\Documents\"
' Excelアプリケーションの新しいインスタンスを生成します。
Set objExcel = CreateObject("Excel.Application")
' Excelを一時的に表示して、フォルダ選択ダイアログを前面に出します。
objExcel.Visible = True
' フォルダ選択ダイアログを表示します。
Set objDialog = objExcel.FileDialog(msoFileDialogFolderPicker)
With objDialog
.Title = "保存先のフォルダを選択してください"
.InitialFileName = initialFolderPath
If .Show = -1 Then
strFolderPath = .SelectedItems(1) & "\"
Else
MsgBox "フォルダが選択されませんでした。"
objExcel.Quit
Set objExcel = Nothing
Exit Sub
End If
End With
' Excelを非表示に戻します。
objExcel.Visible = False
objExcel.Quit
Set objExcel = Nothing
' 選択されたメールアイテムを取得します。
Set objSelection = Application.ActiveExplorer.Selection
If objSelection.Count > 0 Then
For Each objItem In objSelection
If TypeOf objItem Is Outlook.MailItem Then
Set objMail = objItem
' ファイル名に使用できない文字を置換します。
Dim validSubject As String
validSubject = ReplaceInvalidCharactersForFileName(objMail.Subject)
' メールを保存します。
strFileName = strFolderPath & validSubject & ".msg"
objMail.SaveAs strFileName, olMSG
' 添付ファイルを保存します。
Set objAttachments = objMail.Attachments
If objAttachments.Count > 0 Then
For i = 1 To objAttachments.Count
objAttachments.Item(i).SaveAsFile strFolderPath & objAttachments.Item(i).FileName
Next i
End If
End If
Next
End If
End Sub
Function ReplaceInvalidCharactersForFileName(ByVal strSubject As String) As String
' ファイル名として無効な文字を置換します。
Dim validSubject As String
validSubject = Replace(strSubject, ":", "-")
validSubject = Replace(validSubject, "\", "-")
validSubject = Replace(validSubject, "/", "-")
validSubject = Replace(validSubject, "*", "-")
validSubject = Replace(validSubject, "?", "-")
validSubject = Replace(validSubject, """", "-")
validSubject = Replace(validSubject, "<", "-")
validSubject = Replace(validSubject, ">", "-")
validSubject = Replace(validSubject, "|", "-")
Return validSubject
End Functionこのマクロは、大きく分けて以下のステップで構成されます。
ユーザーが保存先フォルダを選択できるようにExcelのファイルダイアログを表示します。
Outlookの選択項目（メール）を取得します。
各メールの件名をファイル名として使用し、指定したフォルダにメールを保存します。
同じく、メールに含まれる添付ファイルも指定したフォルダに保存します。
初期フォルダパスの設定
フォルダ選択ダイアログを開いた時に表示される初期パスを設定します。
initialFolderPath = "C:\Documents\"Excelアプリケーションの起動
フォルダ選択ダイアログを表示するために、Excelアプリケーションのインスタンスを生成します。
Set objExcel = CreateObject("Excel.Application")フォルダ選択ダイアログの表示
Excelのファイルダイアログを利用して、保存先フォルダの選択をユーザーに促します。
objExcel.Visible = True から objExcel.Quit までのブロックメールアイテムの取得
Outlookで選択されたメールアイテムを取得します。
Set objSelection = Application.ActiveExplorer.Selectionメールの保存
メールの件名をファイル名として使い、指定したフォルダに.msg形式で保存します。
strFileName = strFolderPath & validSubject & ".msg" と objMail.SaveAs strFileName, olMSG添付ファイルの保存
メールに添付されたファイルを同じフォルダに保存します。
objAttachments.Item(i).SaveAsFile strFolderPath & objAttachments.Item(i).FileName注意点
データ量が大量の場合
大量のメールや添付ファイルを処理する場合、実行には相応の時間がかかる可能性があります。
元に戻せない操作
このマクロで実行した操作（特にファイルの保存）は自動的には元に戻せませんので、実行前には十分注意してください。
失敗の可能性
メールの件名にファイル名として不適切な文字が含まれている場合、自動的に置換されますが、それでもファイル保存時にエラーが発生する可能性があります。
必要な環境設定
参照設定
このコードを実行するには、VBAエディタで「Microsoft Outlook 15.0 Object Library」（バージョンはインストールされているOutlookによって異なる）への参照設定が必要です。
VBAエディタの「ツール」メニューから「参照設定」を開き、該当するライブラリにチェックを入れてください。
まとめ：メールの情報保存作業の自動化
Outlookでメールとその添付ファイルを一気に保存するVBAマクロのコードを解説しました。
Outlookの操作を自動化して業務効率をアップ。
コメント