このサイトの記事内では「アフィリエイト広告」などの広告を掲載している場合があります。
消費者庁が問題としている「誇大な宣伝や表現」とならないよう配慮しコンテンツを制作しておりますのでご安心ください。
問題のある表現が見つかりましたらお問い合わせよりご一報いただけますと幸いです。

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

2024年10月18日

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

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

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

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

VBAが難しいと感じたら
ココナラにてVBAの作成依頼を受け付けています。
ご依頼・ご相談はこちらから

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

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

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上級者を目指したい人にはパーフェクトExcel VBA一択です。
この本を読み切れば間違いなくVBA上級者になれます。

created by Rinker
技術評論社
¥3,608 (2024/11/23 15:08:04時点 Amazon調べ-詳細)
VBAが難しいと感じたら
ココナラにてVBAの作成依頼を受け付けています。
ご依頼・ご相談はこちらから

VBA

Posted by やろまい