【Outlook】自動日報作成マクロを作ってみた

サーバーの定期更新契約を忘れて、うっかり403エラーを出してしまいました。
申し訳ありません…

さて今回は、OfficeのOutlookに、VBAで自作マクロを組み込んで、自動で日報を作ってくれるようにしてみたお話です。

会社や部活動でよくある「日報」。これ、本当に面倒くさいですよね…
いつも同じフォーマットなのにいちいち手で書かなきゃいけないなんて。

ならば

自動化しましょう！　ってことでVBAでマクロ組んでみました。

Step1．Outlookのメールテンプレートを作成する

まず、Outlookでメールテンプレートを作ります。
そのテンプレートを呼び出して、必要情報を書き換えていくイメージです。

新しい電子メールから本文を書きます。
ただし、日付など変化する場所については、それだと分かる語句にすると良いです。
見たほうが速いですね。

宛先：空欄でOK
件名：【日報】 today
本文： 〇〇さん お疲れ様です、××です。
todayの日報を送付致します。
------------------------------------------------
【today（t_week）】 ※本日のスケジュール
< Today_task_List >
< Today_task_review >
------------------------------------------------
以上、よろしくお願い致します。

この中に記載された、today、t_week、Today_task_List、Today_task_reviewを書き換えて日報にします。

Step2. 置き換える

Sub SendDailyReport()Dim MyItem As Outlook.MailItem
Dim DirName As String
Dim WeekDayList(7) As StringWeekDayList(0) = "日"
WeekDayList(1) = "月"
WeekDayList(2) = "火"
WeekDayList(3) = "水"
WeekDayList(4) = "木"
WeekDayList(5) = "金"
WeekDayList(6) = "土"

'// ************************************************************
'//           Write Folder Address!!　                          
'// ************************************************************
DirName = "ここに日報の内容を書いたフォルダのパスを記入"

Set MyItem = Application.CreateItemFromTemplate(DirName & "report.oft")

' Send Address
MyItem.To = "送信先（to）"

MyItem.CC = "CC送信先（CC）"

' BCC Send Address
MyItem.BCC = "BCC送信先（BCC）"

MyItem.Display
dtshort = FormatDateTime(Now, vbShortDate)
MyItem.Subject = Replace(MyItem.Subject, "today", dtshort)
MyItem.Body = Replace(MyItem.Body, "today", dtshort)

MyItem.Body = Replace(MyItem.Body, "t_week", WeekDayList(Weekday(dtshort) - 1))

' Get today task lists
today_date = Replace(dtshort, "/", "")

Dim buf As String
With CreateObject("Scripting.FileSystemObject")
With .GetFile(DirName & today_date & "_task.txt").OpenAsTextStream
buf = .ReadAll
.Close
End With
End With
MyItem.Body = Replace(MyItem.Body, "", buf)

' Get today task reviews

With CreateObject("Scripting.FileSystemObject")
With .GetFile(DirName & today_date & "_review.txt").OpenAsTextStream
buf = .ReadAll
.Close
End With
End With
MyItem.Body = Replace(MyItem.Body, "", buf)

End Sub

MyItem.Subject = Replace(MyItem.Subject, "today", dtshort)

これで、文字をReplace(置換)しております。
dtshortには今日の日付が入っているため、today を今日の日付と置換します。

With CreateObject("Scripting.FileSystemObject")
With .GetFile(DirName & today_date & "_task.txt").OpenAsTextStream
buf = .ReadAll
.Close
End With
End With
MyItem.Body = Replace(MyItem.Body, "", buf)

これは、外部のテキストファイルを開いて、内容をそのままコピーします。
テキストファイルの中身すべてを buf に保存しているため、
あとは Today_task_List と buf を入れ替えることにより、テキストファイルの内容がそのままメール本文に記載されます。