定期メール自動送信ツールを作成してみましょう。
患者データから一定期間が経過した患者をピックアップし、メールが送信できるツールです。電カルから、患者情報をcsvか何かで引き出せれば、使えると思います。ExcelとOutlookを使用します。Windowsで完全に動作します。Macは使えません（メールの部分）。
①患者情報の日付データをもとに処置・検査の設定期間を超過したかを判定します。
②判定にもとづきメールを送信します。（Mac使用不可）（②の機能のみを使用し、リストに基づいたメール自動送信ツールとしても使用できます。）
なお、電カルからのダウンロードしたデータの形式が種々あると思います。なるべく柔軟に対応できるようにしましたが、データの保存形式によっては全然使えないかもしれません。（ワイド型のデータ形式を想定しています）
また、時間がくれば勝手にメール送信してくれるフルオートではありません。
免責： ツール使用によりメールの誤送信等、事故が発生する可能性があります。ご利用者の責任の下でのご利用をお願いします。 個人情報や患者データは収集しません。
ダウンロードはこちらから
自作したい方は、以下。
シートを２つ作って下さい。
１つは、患者データ と名前をつけて以下のレイアウトにしてください。フォームコントロールからボタンを作成する必要があります。３つボタンを作成した後、後述するsub 期間判定() sub メール() sub メールテスト()を、それぞれのボタンにマクロの登録をしてください。
もうひとつのシートは、１つは、処置検査登録シート と名前を付けて下さい。以下の配列と同じようにしてください。
そして、以下のコードを、エクセルのタブ（開発）の中から、Visual Basicを選択して貼り付けてください。
Sub 期間判定()
'--患者データのどこを対象とするか、列番号を取得する
Dim 処理する年月データ列 As Variant
処理する年月データ列 = InputBox("本日との間隔を評価する日時データの列を教えてください。" & vbCrLf & "アルファベットで記入してください。" & vbCrLf & vbCrLf & "例：d (D列のこと)")
処理する年月データ列 = from_string_to_num(処理する年月データ列) '下の関数from_string_to_numを使用
'--患者データシートの配列入手
Dim 患者データ
Dim Lrow1 As Integer
Dim Lcol1 As Integer
Lrow1 = Worksheets("患者データ").Range("A1").End(xlDown).Row
Lcol1 = Worksheets("患者データ").Range("A1").End(xlToRight).Column
患者データ = Worksheets("患者データ").Range(Cells(2, 1), Cells(Lrow1, Lcol1)).Value '配列に代入
'--処置検査登録シートの配列入手
Worksheets("処置検査登録シート").Select '配列を取得する前に別シートをアクティブにする
Worksheets("処置検査登録シート").Cells(1, 1).Select 'ダイアログ選択の際に、見やすいようにする
Dim 処置検査番号 As Integer
処置検査番号 = InputBox("今回の対象とする処置検査番号を教えてください。処置検査番号とは、A列の通し番号です。" & vbCrLf & "半角数字で入力してください。" & vbCrLf & vbCrLf & "例：1")
Dim 処置検査データ
Dim Lrow2 As Integer
Lrow2 = Worksheets("処置検査登録シート").Range("B1").End(xlDown).Row
処置検査データ = Worksheets("処置検査登録シート").Range(Cells(2, 1), Cells(Lrow2, 6)).Value '配列に代入
'--患者データの日時と、処置検査データの期間を比較する
Dim today '本日の日にちを取得
today = Date
Dim targetdate '期間(日数)を計算する 年×365 ＋ 月×30 ＋ 日
targetdate = 処置検査データ(処置検査番号, 3) * 365 + 処置検査データ(処置検査番号, 4) * 30 + 処置検査データ(処置検査番号, 5)
'以下のifアルゴリズムの結果を格納する判定配列を作成する
Dim 判定配列() As Variant '配列の要素数が動的変数なための工夫１
ReDim 判定配列(Lrow1 - 2) As Variant '配列の要素数が動的変数なための工夫２
'以下のifアルゴリズムの結果を格納するメール本文配列を作成する
Dim メール本文配列() As Variant '配列の要素数が動的変数なための工夫１
ReDim メール本文配列(Lrow1 - 2) As Variant '配列の要素数が動的変数なための工夫２
Dim i As Integer
For i = 1 To Lrow1 - 1 '患者データを順番に処理していく
If today - 患者データ(i, 処理する年月データ列) > targetdate Then '（今日 - 検査処置日時） ＞ 設定期間（日数）の場合
判定配列(i - 1) = "○" '判定配列に○を入れる
メール本文配列(i - 1) = 処置検査データ(処置検査番号, 6) 'メール本文配列に、メール内容テンプレートを入れる
End If
Next i
Worksheets("患者データ").Select '患者データシートに書き出す前に、登録内容シートから、患者データシートに戻る必要がある
On Error GoTo error
Worksheets("患者データ").Range(Cells(2, Lcol1 + 1), Cells(Lrow1 - 2 + 2, Lcol1 + 1)).Value = WorksheetFunction.Transpose(判定配列) '判定配列書き出し
error:
On Error GoTo error1
Worksheets("患者データ").Range(Cells(2, Lcol1 + 2), Cells(Lrow1 - 2 + 2, Lcol1 + 2)).Value = WorksheetFunction.Transpose(メール本文配列) 'メール本文配列書き出し
error1:
Worksheets("患者データ").Cells(1, Lcol1 + 1).Value = 処置検査データ(処置検査番号, 2) & vbCrLf & "超過判定" '新たな列の一番上に名前をつける
Worksheets("患者データ").Cells(1, Lcol1 + 1).HorizontalAlignment = xlCenter '新たな列の一番上の中央揃え 水平
Worksheets("患者データ").Cells(1, Lcol1 + 1).VerticalAlignment = xlCenter '新たな列の一番上の中央揃え 垂直
Worksheets("患者データ").Range(Cells(1, Lcol1 + 1), Cells(1, Lcol1 + 1)).Columns.AutoFit '新たな列の文字列のサイズに列幅を合わす
Worksheets("患者データ").Cells(1, Lcol1 + 2).Value = 処置検査データ(処置検査番号, 2) & vbCrLf & "メール本文" '新たな列の一番上に名前をつける
Worksheets("患者データ").Cells(1, Lcol1 + 2).HorizontalAlignment = xlCenter '新たな列の一番上の中央揃え 水平
Worksheets("患者データ").Cells(1, Lcol1 + 2).VerticalAlignment = xlCenter '新たな列の一番上の中央揃え 垂直
Worksheets("患者データ").Range(Cells(1, Lcol1 + 2), Cells(1, Lcol1 + 2)).Columns.AutoFit '新たな列の文字列のサイズに列幅を合わす
Worksheets("患者データ").Range(Cells(2, Lcol1 + 2), Cells(Lrow1 - 2 + 2, Lcol1 + 2)).RowHeight = 18.75 'メール本文を入れると、行幅が変わってしまうので統一
End Sub
Sub メール()
'--患者データのメールアドレスの列番号を取得する
Dim メール列
メール列 = InputBox("メールアドレスの列を教えてください。アルファベットの半角で入力してください。" & vbCrLf & vbCrLf & "例：g (G列のこと)")
メール列 = from_string_to_num(メール列) '下の関数from_string_to_numを使用
'--患者データの名前の列番号を取得する
Dim 患者の名前列
患者の名前列 = InputBox("患者の名前の列を教えてください。メール件名と、メール本文に反映されます。アルファベットの半角で入力してください。" & vbCrLf & vbCrLf & "例：b (B列のこと)")
患者の名前列 = from_string_to_num(患者の名前列) '下の関数from_string_to_numを使用
'--患者データの判定列番号を取得する
Dim 判定列
判定列 = InputBox("どの列の判定を使って送信しますか。" & vbCrLf & " アルファベットの半角で入力してください。" & vbCrLf & vbCrLf & "例：h (H列のこと)")
判定列 = from_string_to_num(判定列) '下の関数from_string_to_numを使用
Dim 患者データ2
Dim Lrow3 As Integer
Dim Lcol3 As Integer
Lrow3 = Worksheets("患者データ").Range("A1").End(xlDown).Row
Lcol3 = Worksheets("患者データ").Range("A1").End(xlToRight).Column
患者データ2 = Worksheets("患者データ").Range(Cells(2, 1), Cells(Lrow3, Lcol3)).Value '患者データを配列に入力する
Dim k As Integer '配列の要素としての変数を宣言
k = 1
Dim メール対象配列1 As Variant '患者の名前の配列
ReDim メール対象配列1(1 To k) As Variant 'redimは配列の要素数が動的変数なための工夫
Dim メール対象配列2 As Variant 'メールアドレスの配列
ReDim メール対象配列2(1 To k) As Variant 'redimは配列の要素数が動的変数なための工夫
Dim メール対象配列3 As Variant 'メール本文の配列
ReDim メール対象配列3(1 To k) As Variant 'redimは配列の要素数が動的変数なための工夫
Dim i As Integer
For i = 1 To Lrow3 - 1 '患者データを順番に処理
If 患者データ2(i, 判定列) = "○" Then '判定列が、○の場合には以下の処理
ReDim Preserve メール対象配列1(1 To k) 'それぞれの配列の要素数を増やす
ReDim Preserve メール対象配列2(1 To k)
ReDim Preserve メール対象配列3(1 To k)
メール対象配列1(k) = 患者データ2(i, 患者の名前列) '患者の名前配列代入
メール対象配列2(k) = 患者データ2(i, メール列) 'メールアドレスの配列代入
メール対象配列3(k) = 患者データ2(i, 判定列 + 1) 'メール本文の配列代入
k = k + 1 '要素数をif=trueの場合に、１増やす
End If
Next i
'--ここからはoutlookに情報を送るためのコード
Dim toaddress, ccaddress, bccaddress As String '変数設定：To宛先、cc宛先、bcc宛先
Dim subject, mailBody, credit As String '変数設定：件名、メール本文、クレジット、添付
Dim outlookObj As Outlook.Application 'Outlookで使用するオブジェクト生成
Dim mailItemObj As Outlook.MailItem 'Outlookで使用するオブジェクト生成
Dim s
For s = 1 To UBound(メール対象配列1)
'---コード2｜差出人、本文、署名を取得する---
toaddress = メール対象配列2(s) 'To宛先
subject = メール対象配列1(s) & "さんに関するお知らせ" '件名"
mailBody = メール対象配列1(s) & "様へ" & vbCrLf & vbCrLf & メール対象配列3(s) 'メール本文
'---コード3｜メールを作成して、差出人、本文、署名を入れ込む---
Set outlookObj = CreateObject("Outlook.Application")
Set mailItemObj = outlookObj.CreateItem(olMailItem)
mailItemObj.Body = mailBody
mailItemObj.To = toaddress 'to宛先をセット
mailItemObj.subject = subject '件名をセット
'---コード4｜メール本文を改行する
'mailItemObj.Body = mailBody & vbCrLf & vbCrLf & credit 'メール本文 改行 改行 クレジット
'---コード5｜自動で添付ファイルを付ける---
'Dim attached As String
'Dim myattachments As Outlook.Attachments 'Outlookで使用するオブジェクト生成
'Set myattachments = mailItemObj.Attachments
'attached = Range("B9").Value '添付ファイル
'myattachments.Add attached
'---コード6｜メールを送信する---
'mailItemObj.Save '下書き保存
'mailItemObj.Display 'メール表示(ここでは誤送信を防ぐために表示だけにして、メール送信はしない)
mailItemObj.Send
Next s
'---コード7｜outlookを閉じる(オブジェクトの解放)---
Set outlookObj = Nothing
Set mailItemObj = Nothing
End Sub
Sub メールテスト()
Dim メール列
メール列 = InputBox("メールアドレスの列を教えてください。アルファベットの半角で入力してください。" & vbCrLf & vbCrLf & "例：g (G列のこと)")
メール列 = from_string_to_num(メール列)
Dim 患者の名前列
患者の名前列 = InputBox("患者の名前の列を教えてください。アルファベットの半角で入力してください。" & vbCrLf & vbCrLf & "例：b (B列のこと)")
患者の名前列 = from_string_to_num(患者の名前列)
Dim 判定列
判定列 = InputBox("どの列の判定を使って送信しますか。判定根拠となる列を教えてください。" & vbCrLf & " アルファベットの半角で入力してください。" & vbCrLf & vbCrLf & "例：h (H列のこと)")
判定列 = from_string_to_num(判定列)
Dim 患者データ2
Dim Lrow3 As Integer
Dim Lcol3 As Integer
Lrow3 = Worksheets("患者データ").Range("A1").End(xlDown).Row
Lcol3 = Worksheets("患者データ").Range("A1").End(xlToRight).Column
患者データ2 = Worksheets("患者データ").Range(Cells(2, 1), Cells(Lrow3, Lcol3)).Value
Dim k As Integer
k = 1
Dim メール対象配列1 As Variant
ReDim メール対象配列1(1 To k) As Variant
Dim メール対象配列2 As Variant
ReDim メール対象配列2(1 To k) As Variant
Dim メール対象配列3 As Variant
ReDim メール対象配列3(1 To k) As Variant
Dim i As Integer
For i = 1 To Lrow3 - 1
If 患者データ2(i, 判定列) = "○" Then
ReDim Preserve メール対象配列1(1 To k)
ReDim Preserve メール対象配列2(1 To k)
ReDim Preserve メール対象配列3(1 To k)
メール対象配列1(k) = 患者データ2(i, 患者の名前列)
メール対象配列2(k) = 患者データ2(i, メール列)
メール対象配列3(k) = 患者データ2(i, 判定列 + 1)
k = k + 1
End If
Next i
'--ここからはoutlookに情報を送るためのコード
Dim toaddress, ccaddress, bccaddress As String '変数設定：To宛先、cc宛先、bcc宛先
Dim subject, mailBody, credit As String '変数設定：件名、メール本文、クレジット、添付
Dim outlookObj As Outlook.Application 'Outlookで使用するオブジェクト生成
Dim mailItemObj As Outlook.MailItem 'Outlookで使用するオブジェクト生成
Dim s
For s = 1 To UBound(メール対象配列1)
'---コード2｜差出人、本文、署名を取得する---
toaddress = メール対象配列2(s) 'To宛先
subject = メール対象配列1(s) & "さんに関するお知らせ" '件名"
mailBody = メール対象配列1(s) & "様へ" & vbCrLf & vbCrLf & メール対象配列3(s) 'メール本文
'---コード3｜メールを作成して、差出人、本文、署名を入れ込む---
Set outlookObj = CreateObject("Outlook.Application")
Set mailItemObj = outlookObj.CreateItem(olMailItem)
mailItemObj.Body = mailBody
mailItemObj.To = toaddress 'to宛先をセット
mailItemObj.subject = subject '件名をセット
'---コード4｜メール本文を改行する
'mailItemObj.Body = mailBody & vbCrLf & vbCrLf & credit 'メール本文 改行 改行 クレジット
'---コード5｜自動で添付ファイルを付ける---
'Dim attached As String
'Dim myattachments As Outlook.Attachments 'Outlookで使用するオブジェクト生成
'Set myattachments = mailItemObj.Attachments
'attached = Range("B9").Value '添付ファイル
'myattachments.Add attached
'---コード6｜メールを送信する---
mailItemObj.Save '下書き保存
mailItemObj.Display 'メール表示(ここでは誤送信を防ぐために表示だけにして、メール送信はしない)
'mailItemObj.Send 送信
Next s
'---コード7｜outlookを閉じる(オブジェクトの解放)---
'Set outlookObj = Nothing
'Set mailItemObj = Nothing
End Sub
Function from_string_to_num(va As Variant) As Variant '変換する関数
from_string_to_num = Range(va & "1").Column '列番号を取得
End Function