【OutlookVBA】メールを保存する時に日付を自動挿入する方法

Outlookメールの保存をしていますか?

私は重要なメールはmsg形式で保存するようにしています

そして、保存する時にタイトルの先頭に日付を付けているのですが、手間がかかるのでマクロ(OutlookVBA)で自動化することにしました。

ワンクリックで日付を付けて保存できるので、同じようにメール管理している方は真似してみてはどうでしょうか?

タイトルの先頭に日付を付けるマクロ

タイトルの先頭に日付を付けるマクロは以下のようになります。

SAVE_FOLDER_PATHにファイルを保存フォルダへのパスを入れると使えます。

Sub SaveMailWithDate()
'タイトルの先頭に日付を付けてメールを保存(保存フォルダ固定)
    Const SAVE_FOLDER_PATH = "C:\USER..." 'ファイルを保存するフォルダへのパス
    Dim mllItem As Outlook.MailItem
    Set mllItem = GetCurrentItem
    If mllItem Is Nothing Then Exit Sub
    
    Dim strName As String
    strName = mllItem.Subject
    
    'ファイル名に使用できない文字列を置換
    Dim arrNG As Variant: arrNG = Array("/", ":", "*", "?", Chr(34), "<", ">", "|")
    Dim arrOK As Variant: arrOK = Array("/", ":", "*", "?", """, "<", ">", "|")
    Dim i As Long
    For i = LBound(arrNG) To UBound(arrNG)
        strName = Replace(strName, arrNG(i), arrOK(i))
    Next
    
    '日付を追加
    strName = Format(Date, "yymmdd") & "-" & strName
    
    'メールを保存
    mllItem.SaveAs SAVE_FOLDER_PATH & "\" & strName & ".msg"
    
End Sub

Private Function GetCurrentItem() As Object
'選択中のメールアイテムオブジェクトを返す
    On Error Resume Next
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer" 'Outlookのメインウィンドウがアクティブ
            Set GetCurrentItem = Application.ActiveExplorer.Selection.Item(1)
        Case "Inspector" 'Outlookのメールウィンドウがアクティブ
            Set GetCurrentItem = Application.ActiveInspector.CurrentItem
    End Select
End Function

3点ほどポイントを説明します。

    Set mllItem = GetCurrentItem

メールアイテムはGetCurrentItemという自作関数を使って取得しています。

Outlookはメインウィンドウがアクティブな場合と、メールウィンドウがアクティブな場合でメールアイテムを取得する方法が異なります。

この違いに対応するため、 GetCurrentItem内でSelect Caseを使って処理を分岐させています。

    'ファイル名に使用できない文字列を置換
    Dim arrNG As Variant: arrNG = Array("/", ":", "*", "?", Chr(34), "<", ">", "|")
    Dim arrOK As Variant: arrOK = Array("/", ":", "*", "?", """, "<", ">", "|")
    Dim i As Long
    For i = LBound(arrNG) To UBound(arrNG)
        strName = Replace(strName, arrNG(i), arrOK(i))
    Next

ファイル名は日付+メールタイトルにするのですが、メールタイトルにファイル名として使えない文字が入っていた場合に文字列を全角へ置き換えしています。

Chr(34)については下の記事を参照してください。

    '日付を追加
    strName = Format(Date, "yymmdd") & "-" & strName

日付の追加はこの箇所で行っています。

Format関数でyymmddの形式で日付を追記しています。年を2桁にしていますが、4桁にしたい場合はyyyymmddへ変えます。

保存フォルダをダイアログで選択したい場合

先ほどのプログラムは保存するフォルダを固定していますが、保存フォルダを毎回選択したい人に向けてもう1つプログラムを作成しました。

Sub SaveMailWithDate2()
'タイトルの先頭に日付を付けてメールを保存(保存フォルダをダイアログで選択))
    Dim mllItem As Outlook.MailItem
    Set mllItem = GetCurrentItem
    If mllItem Is Nothing Then Exit Sub
    
    Dim strName As String
    strName = mllItem.Subject
    
    'ファイル名に使用できない文字列を置換
    Dim arrNG As Variant: arrNG = Array("/", ":", "*", "?", Chr(34), "<", ">", "|")
    Dim arrOK As Variant: arrOK = Array("/", ":", "*", "?", """, "<", ">", "|")
    Dim i As Long
    For i = LBound(arrNG) To UBound(arrNG)
        strName = Replace(strName, arrNG(i), arrOK(i))
    Next
    
    '日付を追加
    strName = Format(Date, "yymmdd") & "-" & strName
    
    '保存フォルダをダイアログで選択(ExcelAppを利用)
    Dim saveFolderPath As String
    Dim xlApp As Object: Set xlApp = CreateObject("Excel.Application")
    With xlApp.FileDialog(msoFileDialogFolderPicker)
        If .Show = 0 Then MsgBox "キャンセルボタンが押されました": Exit Sub
        saveFolderPath = .SelectedItems(1)
    End With
    Set xlApp=Nothing
    
    'メールを保存
    mllItem.SaveAs saveFolderPath & "\" & strName & ".msg"
    
End Sub

Private Function GetCurrentItem() As Object
'選択中のメールアイテムオブジェクトを返す
    On Error Resume Next
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer" 'Outlookのメインウィンドウがアクティブ
            Set GetCurrentItem = Application.ActiveExplorer.Selection.Item(1)
        Case "Inspector" 'Outlookのメールウィンドウがアクティブ
            Set GetCurrentItem = Application.ActiveInspector.CurrentItem
    End Select
End Function
    '保存フォルダをダイアログで選択(ExcelAppを利用)
    Dim saveFolderPath As String
    Dim xlApp As Object: Set xlApp = CreateObject("Excel.Application")
    With xlApp.FileDialog(msoFileDialogFolderPicker)
        If .Show = 0 Then MsgBox "キャンセルボタンが押されました": Exit Sub
        saveFolderPath = .SelectedItems(1)
    End With
    Set xlApp=Nothing

先ほどのプログラムと異なっているのはこの部分です。

この部分でダイアログを表示して、保存フォルダを選択できるようにしています。

ダイアログを表示するために、Excelアプリケーションを利用しています。

マクロをボタン登録する方法

名前を付けて保存は何回も行う動作なので、マクロをボタン登録するのがオススメです。

OutlookではExcelのようにフォームコントロールがないため、私はクイックアクセスツールバーに登録しています。

マクロをボタン登録する方法
マクロをボタン登録する方法
マクロをボタン登録する方法

画像のように「その他のコマンド」⇒「マクロ」と進むとマクロをクイックアクセスツールバーに登録できます。

クイックアクセスツールバーに登録して、ポチっと名前を付けて保存をやってみてください。

《VBA初心者におすすめの本》
VBA初心者には、株式会社すごい改善さんの本が分かりやすくておすすめです。

created by Rinker
技術評論社
¥2,178 (2021/12/01 14:22:42時点 Amazon調べ-詳細)

動画で学びたい人には、すごい改善さんのUdemy講座をおすすめします。
【累計36万部著者が教える】たった1日で!まったくの初心者でも最短でExcel VBAを仕事で活用できるようになる講座

他の「VBA」の記事はこちらからどうぞ

VBA

Posted by やろまい