コピペで簡単に業務効率化！メールに報告期間の日付を自動で入力する方法【Outlook VBA】

朝日葵菜（Asahi Kina）

2023年6月12日 18:13

週報や月報など報告メールによっては「開始日の日付」と「終了日の日付」が必要になるものもありますよね。２つの日付を入力するのはなかなか面倒…。

そこで今回は、週報などで開始日と終了日が必要になる際に便利な「今日の日付」と「指定した日数分前の日付」を自動で入力してくれるマクロを紹介します。

今回は週報を例に作成していきますが、さまざまなパターンの日付の表記にも対応できるようなマクロにしてみました。

コピペするだけで簡単にマクロが作成できるので、プログラミング初心者の方もぜひ挑戦してみてください。

01.開発タブの表示【事前準備】

まずはマクロ作成の基本、「開発」タブを表示させていきます。

１）「ファイル」を開いて「オプション」を選択します。

２）「リボンのユーザー設定」を選択し、「開発」にチェックを入れて「OK」をクリックします。

これで「開発」タブが表示されるようになりました。

02.メールテンプレートの作成

ここでは、メールのテンプレートを作成していきます。

１）普段通りに「新しいメール」から、作成したいメールを作成します。

２）作成したテンプレートを以下の通りに変更してください。

①署名をデフォルトで設定している場合は署名を削除
②日付を以下の対応する文字列に変更
　西暦　 →　　yyyy
　開始日の月　　　→　　m
　開始日の日にち　→　　d
　開始日の曜日　　→　　(w)

　今日の月　　　→　　mm
　今日の日にち　→　　dd
　今日の曜日　　→　　(ww)

⚠️年をまたいだ日付の入力は想定していないので、年をまたぐ場合は手動で変更してください。

３）「ファイル」をクリックして「名前をつけて保存」を選択します。

４）「ファイル名」を好きな名前に設定して、「ファイルの種類」を「Outlookテンプレート(*.oft)」に変更してから「保存」をクリックします。

⚠️ファイルのパスはマクロを作成する際に使用します。保存した場所を忘れないようにしてください。

これでメールのテンプレートの作成が完了しました。

03.マクロの作成

続いてマクロを作成していきます。

１）「開発」タブを開いて、「マクロ」内の「マクロ」をクリックしてください。

２）「マクロ名」に内容が分かりやすい名前を入力して「作成」をクリックします。

３）「Microsoft Visual Basic for Applications」の画面が開きます。

４）以下のコードをメモ帳か何かにコピペして、「”★フォルダパス★\テンプレート名.oft”」の部分をメールのテンプレートを格納したフォルダパスとテンプレート名に変更してください。

🌟エクスプローラーでメールのテンプレートを選択した状態で「ホーム」タブ内の「パスのコピー」をクリックすることで一瞬でファイル名までコピーできます。

Dim Temp As Outlook.MailItem
Dim WeekD As String
Dim TimeDate As Date: TimeDate = Now
Dim a As Integer: a = CInt(Day(TimeDate))

'何日前の日付にしたいかを選択
Dim DayAgo As Integer: DayAgo = 4

'テンプレートを開く
    Set Temp = Application.CreateItemFromTemplate("★フォルダパス★\テンプレート名.oft")
    Temp.Display

'今日の曜日を取得
    WeekD = WeekdayName(Weekday(Date))
    WeekDa = WeekdayName(Weekday(Date - DayAgo))
    
'曜日を削除
    WeekD = Replace(WeekD, "曜日", "")
    WeekDa = Replace(WeekDa, "曜日", "")

'件名の日付を変更
    Temp.Subject = Replace(Temp.Subject, "yyyy", Year(Now))
    Temp.Subject = Replace(Temp.Subject, "mm", Month(Now))
    Temp.Subject = Replace(Temp.Subject, "dd", Day(Now))
    Temp.Subject = Replace(Temp.Subject, "ww", WeekD)

    '指定した日数日分前の日付に変更
        Temp.Subject = Replace(Temp.Subject, "d", Day(Now - DayAgo))

        If a <= DayAgo Then
            Temp.Subject = Replace(Temp.Subject, "m", Month(Now) - 1)
        Else
            Temp.Subject = Replace(Temp.Subject, "m", Month(Now))
        End If
        Temp.Subject = Replace(Temp.Subject, "(w)", "(" + WeekDa + ")")
        
'本文の日付を変更
    Temp.Body = Replace(Temp.Body, "yyyy", Year(Now))
    Temp.Body = Replace(Temp.Body, "mm", Month(Now))
    Temp.Body = Replace(Temp.Body, "dd", Day(Now))
    Temp.Body = Replace(Temp.Body, "ww", WeekD)

    '指定した日数日分前の日付に変更
        Temp.Body = Replace(Temp.Body, "d", Day(Now - DayAgo))

        If a <= DayAgo Then
            Temp.Body = Replace(Temp.Body, "m", Month(Now) - 1)
        Else
            Temp.Body = Replace(Temp.Body, "m", Month(Now))
        End If
        Temp.Body = Replace(Temp.Body, "(w)", "(" + WeekDa + ")")