今回は 「保存形式とファイル名ルールをConfigシートで一括管理する版」 と 「保存後に自動でメール通知する版」 を紹介します。
1. 保存形式とファイル名ルールをConfigシートで一括管理する版
Configシートに以下の情報を記載しておきます：
- A1: 保存先フォルダ
- A2: 保存形式（
XLSX/CSV） - A3: ファイル名ルール（例:
MergedResult_{DATE}_{TIME}）
Sub SaveMerged_ConfigRules()
Dim wsMaster As Worksheet, wsConfig As Worksheet
Dim newWb As Workbook
Dim folderPath As String, formatStr As String, nameRule As String
Dim savePath As String, todayStr As String, timeStr As String
Set wsMaster = ThisWorkbook.Sheets("Master")
Set wsConfig = ThisWorkbook.Sheets("Config")
folderPath = wsConfig.Range("A1").Value
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
formatStr = UCase(wsConfig.Range("A2").Value)
nameRule = wsConfig.Range("A3").Value
todayStr = Format(Now, "yyyy-mm-dd")
timeStr = Format(Now, "HHNN")
' ファイル名ルールに置換
nameRule = Replace(nameRule, "{DATE}", todayStr)
nameRule = Replace(nameRule, "{TIME}", timeStr)
' 新しいブックを作成
Set newWb = Workbooks.Add
wsMaster.UsedRange.Copy newWb.Sheets(1).Cells(1, 1)
Application.DisplayAlerts = False
Select Case formatStr
Case "XLSX"
savePath = folderPath & nameRule & ".xlsx"
newWb.SaveAs Filename:=savePath, FileFormat:=xlOpenXMLWorkbook
Case "CSV"
savePath = folderPath & nameRule & ".csv"
newWb.Sheets(1).SaveAs Filename:=savePath, FileFormat:=xlCSVUTF8
Case Else
MsgBox "Configシートの保存形式が不正です。XLSX または CSV を指定してください。"
End Select
Application.DisplayAlerts = True
newWb.Close SaveChanges:=False
MsgBox "統合結果を保存しました: " & savePath
End Sub
2. 保存後に自動でメール通知する版
保存完了後に、Outlookを使って通知メールを送信します。
※ Configシートに宛先アドレスを記載しておくと便利です。
Sub SaveMergedAndNotify()
Dim wsMaster As Worksheet
Dim newWb As Workbook
Dim savePath As String, todayStr As String
Dim toAddr As String
Set wsMaster = ThisWorkbook.Sheets("Master")
' 保存先と宛先をConfigシートから取得
Dim wsConfig As Worksheet
Set wsConfig = ThisWorkbook.Sheets("Config")
savePath = wsConfig.Range("B1").Value ' 保存先パス
toAddr = wsConfig.Range("B2").Value ' 宛先メールアドレス
todayStr = Format(Now, "yyyy-mm-dd HH:NN:SS")
' 新しいブックを作成
Set newWb = Workbooks.Add
wsMaster.UsedRange.Copy newWb.Sheets(1).Cells(1, 1)
Application.DisplayAlerts = False
newWb.SaveAs Filename:=savePath, FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
newWb.Close SaveChanges:=False
' 保存完了通知メール
Call SendMail(toAddr, "[CSV統合完了通知]", _
"統合結果を保存しました。" & vbCrLf & _
"保存先: " & savePath & vbCrLf & _
"日時: " & todayStr)
MsgBox "統合結果を保存し、通知メールを送信しました。"
End Sub
' Outlookメール送信用の汎用関数
Function SendMail(toAddr As String, subjectText As String, bodyText As String) As Boolean
On Error GoTo ErrHandler
Dim olApp As Object, olMail As Object
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(0)
With olMail
.To = toAddr
.Subject = subjectText
.Body = bodyText
.Send
End With
SendMail = True
Exit Function
ErrHandler:
SendMail = False
End Function
✅ まとめ
- Configシート一括管理版 → 保存先・形式・ファイル名ルールを外部管理できるので柔軟に変更可能。
- 保存＋通知版 → 保存完了後に自動でメール通知できるので、運用監視が容易。
