業務報告的なメールをVBAで作成する

はじめに

在宅勤務で業務報告的なことを毎日メールするけどそれを作るのが面倒なので、作業と時間をエクセルにメモしておいたらボタン１つでメールにしてくれるマクロにしました。
自動で送信までしちゃうのは怖いので送信は文章を確認してから手動で行うようにしています。

実装

シート

こんなシートを用意します。

シート：やったことリスト

シート：テンプレ

VBA

VBAはこんな感じになりました。
ブックの標準モジュールに保存したけどシートオブジェクトの方に保存してもいけそう。

Sub createMail_Click()
    'MsgBox "メール作成します"
    Dim objOutlook As Outlook.Application
    Dim objMail As Outlook.MailItem
    
    Set objOutlook = New Outlook.Application
    Set objMail = objOutlook.CreateItem(olMailItem)
    
    objMail.To = getVal("宛先")         'メール宛先
    objMail.Subject = getVal("件名")    'メール件名
    objMail.BodyFormat = olFormatPlain  'メールの形式
    Dim body As String                  'メール本文
    body = getVal("本文ヘッダ") + vbCrLf
    
    Dim list As String: list = getDidToday()        '明細
    body = body + list + vbCrLf
    body = body + getVal("本文フッタ") + vbCrLf
    
    objMail.body = body
    objMail.Display         'メール表示
End Sub

'明細部分を返す
Function getDidToday() As String
    Set wsDone = ThisWorkbook.Sheets("やったことリスト")
    Dim i As Integer: i = 1
    Dim buf As String

    Do
        'Debug.Printを使うとイミディエイトウィンドウに変数の中身を出せる
        Debug.Print wsDone.Cells(i, 2).Value, TypeName(wsDone.Cells(i, 2).Value)
        
        Dim point As String: point = wsDone.Cells(i, 1).Value                       '箇条書きの「・」
        Dim hour As String: hour = CStr(Format(wsDone.Cells(i, 2).Value, "0.0"))    '時間
        Dim desc As String: desc = wsDone.Cells(i, 3).Value                         '内容
        
        '合計行まで来たら終わり
        If point = "合計" Then
            buf = buf + "---------------" + vbCrLf
            buf = buf + point + hour + "H" + vbCrLf
            Exit Do
        End If
        '0時間以外は明細に出力する
        If point = "・" And hour <> "0.0" Then
            buf = buf + point + hour + "H" + " : " + desc + vbCrLf
        End If
        i = i + 1
    Loop While i < 100  '無限ループ怖いので上限
    
    getDidToday = buf   'なぜVBAはこういう仕組みになったのだろう
End Function

'VLOOKUP関数でテンプレシートB列から値を取る
Function getVal(target As String) As String
    'Dim buf As String: buf = WorksheetFunction.VLookup(target, Worksheets("テンプレ").Range("A:B"), 2, False)
    getVal = WorksheetFunction.VLookup(target, Worksheets("テンプレ").Range("A:B"), 2, False)
End Function

'時間列でフィルタをかける
Sub filterOn_Click()
    ActiveSheet.Range(Range("A8"), Cells(Rows.Count, 3).End(xlUp)).AutoFilter Field:=2, Criteria1:=">0"
End Sub
'フィルタを解除する
Sub filterOff_Click()
    ActiveSheet.Range(Range("A8"), Cells(Rows.Count, 3).End(xlUp)).AutoFilter
End Sub

動かす前にツール→参照設定に以下が追加されていることを確認。
メールオブジェクトを使用するための参照設定です。
設定していない場合エラーになります。

• Microsoft Outlook 1X.0 Object library

動かしてみる

メールを作るボタン

メールを作るボタンを押下するとこんなメールを作ってくれます。
やってない作業は除外されてますね。

おまけ

フィルタボタンとフィルタ解除ボタンはおまけです。
それぞれ中身1行の関数作るだけでフィルタしてくれました。

フィルタの範囲指定では行の最期を指定していないので行挿入してもいい感じにフィルタ対象になってくれます。

おわりに

最初はVBA無しでエクセル関数のHYPERLINK()だけでメール作成してました。
ただそれだと動的に明細部分を本文に挿入できなかったので、

1. HYPERLINK()でメール作成
2. 手作業で0時間以外でフィルタかける
3. フィルタ結果をコピーして作成したメールに値貼り付け

という操作が必要で面倒になりVBAにしました。
なのでもしエクセル関数だけでできるなら教えてほしいです。。