◆これまでに感じたこと
これまでにいくつかのツールを作成してみた結果、VBScript は日々の業務作業を効率化するうえで非常に有効な手段だと感じています。
特別な開発環境を用意せずに Windows 標準機能だけで自動化処理を実装できる点は、運用作業や定型業務との相性が良く、今後も活用の幅を広げながら理解を深めていきたいと考えています。
◆本コードで実現していること
デフォルトでは「Cc」の項目が表示されないため、「Cc」フィールドを表示させる処理を追加しました。
その後、Excelから取得したメールアドレスをCcフィールドに入力できるようにしています。
具体的には、以下の処理を実現しています：
- Becky! メールクライアントを起動し、新規メール作成画面を開きます。
- 差出人（To）と件名を設定します。
- 「Cc」フィールドがデフォルトで非表示のため、Ctrl+Shift+C のキーストロークを送信し、「Cc」フィールドを表示させます。
- その後、Excelの6列目3行目に設定されたメールアドレスを「Cc」フィールドに入力します。
これにより、宛先（To）だけでなく、カーボンコピー（Cc）にも自動的にメールアドレスが入力されるようになります。
＜顧客管理一覧＞
＜メールアドレスの入力項目＞
＜当日連絡の本文＞
Option Explicit
Dim shell, src_mail, cc_mail
Dim xl, wb, ws, text1, textAll, companyName, contactName
Dim textBody
Set shell = CreateObject("WScript.Shell")
' Excel 起動
Set xl = CreateObject("Excel.Application")
xl.Visible = False
' ファイルを開く
Set wb = xl.Workbooks.Open("C:\Users\sasio-tech.SASIO.JP\Documents\メール文自動作成\作業環境リスト.xlsx")
Set ws = wb.Sheets(1)
' Becky! を起動
shell.Run """C:\Program Files (x86)\RimArts\B2\B2.exe""", 1, False
' 起動待ち
' WScript.Sleep 2000
' Becky! をアクティブにする（タイトルは環境に合わせて変更）
shell.AppActivate "Becky!"
WScript.Sleep 300
' メール(M) → 新規メールの作成(N)のウィンドウを表示
shell.SendKeys "%m" ' Alt + M
WScript.Sleep 300
shell.SendKeys "c" ' 新規メールの作成(N)
WScript.Sleep 800
' Ccに移動（Tab 1回）
shell.SendKeys "%{DOWN}" ' Alt + ↓
WScript.Sleep 300
' 4行目 3列目の値（メールアドレス）を取得
src_mail = ws.Cells(3, 4).Value
' 下記のメールアドレスの差出人を入力
shell.SendKeys src_mail
WScript.Sleep 300
' Ccに移動（とりあえず TAB 1回にしてみる例）
shell.SendKeys "{TAB}"
WScript.Sleep 300
' 4行目 3列目の値（メールアドレス）を取得
cc_mail = ws.Cells(3, 6).Value
' Ccにメールアドレスを入力
shell.SendKeys cc_mail
WScript.Sleep 300
' 件名に移動（とりあえず TAB 1回にしてみる例）
shell.SendKeys "{TAB}"
WScript.Sleep 300
' 下記の件名入力（検証用に英数字だけ）を入力
shell.SendKeys "test_mail_subject_123"
WScript.Sleep 300
' シート1 の B3 を取得
text1 = ws.Cells(3, 2).Value ' ← B3
' ★★★ ここから追加：G3 をチェックして本文を切り替える ★★★
If ws.Cells(3, 7).Value = "〇" Then
Dim fso, filePath, ts, bytes, i, char, lines
filePath = "C:\Users\sasio-tech.SASIO.JP\Documents\メール文自動作成\当日連絡.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(filePath) Then
' 本文へ
shell.SendKeys "{TAB}"
WScript.Sleep 300
' バイナリとして読み込む
Set ts = fso.OpenTextFile(filePath, 1, False)
textBody = ts.ReadAll
ts.Close
' --- ここから置き換え処理 ---
lines = Split(textBody, vbCrLf)
' Excel の会社名（B3）と担当者名（C3）を取得
companyName = ws.Cells(3, 2).Value ' 2列目 3行目が会社名
contactName = ws.Cells(3, 3).Value ' 3列目 3行目が担当者名
' 1行目に 〇〇〇〇〇〇 が含まれていたら会社名と担当者名を置換
' 1行目に 〇〇〇〇〇〇 が含まれていたら会社名と担当者名を置換
If InStr(lines(0), "〇〇〇〇〇〇") > 0 Then
lines(0) = Replace(lines(0), "〇〇〇〇〇〇", companyName)
End If
' 2行目に 〇〇〇〇〇様 が含まれていたら担当者名を置換
If InStr(lines(1), "〇〇〇〇〇様") > 0 Then
lines(1) = Replace(lines(1), "〇〇〇〇〇様", contactName & "様")
End If
textBody = Join(lines, vbCrLf)
' --- ここまで ---
Else
textBody = "当日連絡.txt が見つかりませんでした。"
End If
Else
textBody = "ここに長文が表示されます"
End If
' ★★★ 追加ここまで ★★★
' Excel を閉じる
wb.Close False
xl.Quit
' 結合（B3 → 改行 → 長文）
' textAll = text1 & "様" & vbCrLf & vbCrLf & textBody
textAll = textBody
' クリップボードに本文を入れる（改行対応版）
Dim clipCmd
clipCmd = "cmd /c echo(" & Replace(textAll, vbCrLf, "^& echo(") & " | clip"
shell.Run clipCmd, 0, True
WScript.Sleep 300
' 貼り付け（Ctrl + V）
shell.SendKeys "^v"
WScript.Sleep 300
' 下書き保存
shell.SendKeys "%f"
WScript.Sleep 300
shell.SendKeys "d"
MsgBox "下書き保存されました"
