残業予定をexcelに記述し申請メールを自動送信する

たとえば残業は16時までにメールで申請、とかってあるよね。
残業するときにそのメールを書くってだけで面倒で嫌になるから、
excelに記入した内容で申請メールを自動送信するマクロ&VBScriptを書いた。

要BSMTP.DLL&BSENDM.EXE。WINDOWS\system32ディレクトリに配置して。
BASP21 DLL

こんなexcelを作る。ここではOvertime.xlsとする。

VBA

Private Declare Function SendMailEx Lib "bsmtp" _
      (szLogfile As String, szServer As String, szTo As String, _
       szFrom As String, szSubject As String, szBody As String, szFile As String) As String

Public Sub sendOvertimeMail()
    
    Dim today As String
    today = Format(Date, "m月d日")
    
    Dim dateCell As Variant
    Set dateCell = Columns("A:A").Find(What:=today, LookIn:=xlValues, LookAt:=xlWhole)
    
    If dateCell Is Nothing Then
        MsgBox today & "のセルがありません"
        Exit Sub
    End If
    
    Dim sb As Object
    Set sb = CreateObject("System.Text.StringBuilder")
    
    Dim body As String
    
    sb.Append_3 ("お疲れさまです。")
    sb.Append_3 (vbLf)
    sb.Append_3 ("本日")
    sb.Append_3 (today)
    sb.Append_3 ("の残業予定を報告いたします。")
    sb.Append_3 (vbLf)
    sb.Append_3 (vbLf)
    sb.Append_3 (vbLf)
    sb.Append_3 ("    ")
    sb.Append_3 (Range("B1").Value)
    sb.Append_3 ("    ")
    sb.Append_3 (Format(Range("B" & dateCell.Row).Value, "hh:mm"))
    sb.Append_3 (vbLf)
    sb.Append_3 (vbLf)
    sb.Append_3 (vbLf)
    sb.Append_3 ("以上です。")
    sb.Append_3 (vbLf)
    sb.Append_3 ("どうぞよろしくお願いいたします。")
    sb.Append_3 (vbLf)
    sb.Append_3 ("※このメールはタイマーにより自動送信しています。")
    
    body = sb.ToString
    
    Dim errorMessage As String
    errorMessage = SendMailEx( _
        "c:\log.txt", _
        "SMTPサーバー", _
        "Toアドレス", _
        "Fromアドレス" & vbTab & "SMTPユーザー名:パスワード", _
        today & "の残業予定", _
        body, _
        "")
    
    If errorMessage <> "" Then
        MsgBox "メール送信でエラーが発生しました" & vbLf & errorMessage
    End If
End Sub

VBSからは標準モジュールにあるマクロしか呼び出せないので、
標準モジュールに関数を記述した。

Public Sub proceed()
    ThisWorkbook.sendOvertimeMail
End Sub

VBScript

Dim xlApp
Set xlApp = CreateObject("Excel.Application")

xlApp.Visible = FALSE
Dim myBook
Set myBook = xlApp.Workbooks.Open("C:\Overtime.xls")
xlApp.Run myBook.name & "!Module1.proceed"
Wscript.Sleep 2000 '2秒
xlApp.Quit

Set xlApp = Nothing

このVBSをコントロールパネル→タスクで登録しておけば、定刻になるとメールを自動送信してくれる。