複数のセル範囲をそれぞれHTMLテーブルに変換し、1通のOutlookメール本文にまとめて埋め込む実務向けVBAです。書式（罫線・色・フォント）も保持されます。
コード全体
Option Explicit
' 指定したセル範囲をHTML（<table>含む）文字列に変換
Function RangeToHtml(rng As Range) As String
Dim tempWB As Workbook
Dim tempFile As String
Dim fso As Object, ts As Object
Dim html As String
' 一時HTMLファイルパス
tempFile = Environ("TEMP") & "\range_temp_" & Format(Now, "yyyymmddhhnnss") & ".htm"
' 範囲を新規ブックに貼り付け→HTML保存
rng.Copy
Set tempWB = Workbooks.Add(1)
With tempWB.Sheets(1)
.Cells(1, 1).PasteSpecial Paste:=xlPasteAll
Application.CutCopyMode = False
End With
Application.DisplayAlerts = False
tempWB.SaveAs Filename:=tempFile, FileFormat:=xlHtml
tempWB.Close False
Application.DisplayAlerts = True
' HTML読み込み
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(tempFile, 1)
html = ts.ReadAll
ts.Close
' 一時ファイル削除
On Error Resume Next
Kill tempFile
On Error GoTo 0
' そのまま返す（<html>全体含む）。後段で抽出して使う場合は整形してもOK
RangeToHtml = html
End Function
' HTMLの<body>内だけを抽出（Outlook本文に埋め込みやすくするため）
Function ExtractBodyHtml(html As String) As String
Dim s As Long, e As Long
Dim bodyHtml As String
s = InStr(1, html, "<body", vbTextCompare)
If s = 0 Then
ExtractBodyHtml = html
Exit Function
End If
s = InStr(s, html, ">", vbTextCompare) + 1
e = InStr(1, html, "</body>", vbTextCompare)
If e = 0 Then
ExtractBodyHtml = Mid$(html, s)
Else
ExtractBodyHtml = Mid$(html, s, e - s)
End If
End Function
' 複数範囲をHTMLとして1通のOutlookメールにまとめて送信
Sub SendMultiRangesAsOneHtmlMail()
Dim outlookApp As Object, mailItem As Object
Dim htmlParts As String, header As String, footer As String
Dim part As String
' 対象範囲（例）：Sheet1の表A、表B、Sheet2の表C
Dim r1 As Range, r2 As Range, r3 As Range
Set r1 = ThisWorkbook.Sheets("Sheet1").Range("A1:D15")
Set r2 = ThisWorkbook.Sheets("Sheet1").Range("F1:J12")
Set r3 = ThisWorkbook.Sheets("Sheet2").Range("B2:E20")
' 各範囲をHTML化 → body部分を抽出して連結
part = ExtractBodyHtml(RangeToHtml(r1))
htmlParts = htmlParts & "<h3 style='color:#2a6;'>表A</h3>" & part & "<hr>"
part = ExtractBodyHtml(RangeToHtml(r2))
htmlParts = htmlParts & "<h3 style='color:#2a6;'>表B</h3>" & part & "<hr>"
part = ExtractBodyHtml(RangeToHtml(r3))
htmlParts = htmlParts & "<h3 style='color:#2a6;'>表C</h3>" & part
' 全体のHTML（スタイルなど必要に応じて追加）
header = "<div style='font-family:Meiryo, Segoe UI, Arial; font-size:12.5px;'>" & _
"<p>以下に複数のExcel範囲をHTMLとしてまとめました。</p>"
footer = "<p style='color:#777;'>自動送信：Excel VBA</p></div>"
' Outlookメール作成
Set outlookApp = CreateObject("Outlook.Application")
Set mailItem = outlookApp.CreateItem(0)
With mailItem
.To = "user@company.com"
.CC = ""
.BCC = ""
.Subject = "複数範囲のHTMLレポート"
.HTMLBody = header & htmlParts & footer
.Display ' 内容確認後に送信。即送信なら .Send
End With
End Sub
補足と運用のコツ
- 複数範囲の見出しは
<h3>などで明示し、<hr>で区切ると可読性が上がります。 - 書式（セル色・罫線）を保ちたい場合は、変換元の範囲で整えてから実行するとそのまま反映されます。
- 画像やチャートを含む場合は、HTML変換では崩れることがあるため、別途添付にするか、画像として貼り付ける処理に切り替えるのが安全です。
- 一時ファイルの削除に失敗するケースに備え、テンポラリのクリーンアップバッチを用意しておくと運用が安定します。
さらに使いやすくするには
- 見出し名・範囲アドレス・宛先をシート「Config」に外出しして、ループで動的に処理。
- 送信前プレビューが不要なら
.Displayを.Sendに変更し、夜間バッチで自動送信。 - HTMLのヘッダーに軽いCSS（テーブル幅・フォント・余白）を入れるとレイアウトが安定します。
