Contents
この記事でできること
- VBAでExcelの指定範囲をHTMLテーブルに変換できる
- 変換した表をOutlookメール本文に罫線・書式付きで挿入できる
- 一覧表から宛先・件名を読み取り、複数メールを一括作成できる（実務版）
対象: Excel 2016以降 / Microsoft 365、Windows 10/11
必要: Outlookインストール済み・初回起動済み
完成イメージ（Before / After）
Before（手動コピペ）:
- Excelで表を選択してコピー
- Outlookの新規メールを開く
- メール本文に貼り付け → 罫線が消える・書式が崩れる
- 手動で表を整え直す（または諦めてそのまま送る）
After（VBAで自動挿入）:
- マクロを実行（またはボタンをクリック）
- Excelの表がHTMLテーブルに変換される
- Outlookの下書きメールが開き、本文に表が罫線付きで挿入されている
- 署名もそのまま残っている
- 内容を確認してから送信ボタンを押す
自分も毎週、売上集計表をExcelからメール本文にコピペしていた。ところが貼り付けると罫線が消えて、数字がただ並んだだけの見づらいメールになった。ある日、上司から「この表、見づらいんだけど」と返信が来て恥ずかしかった。VBAでExcelの表をHTML化してOutlookメール本文に挿入するようにしたら、罫線も書式もそのまま。受け取る側から「見やすくなった」と言われるようになった。毎回コピペで書式崩れと格闘している人に、この記事で「表がそのままメールに入る」感覚を体験してほしい。
Excelの表をメール本文にきれいに入れるコツは「HTMLテーブルに変換してHTMLBodyに挿入する」こと。手動コピペでは再現できない罫線と書式がそのまま届く。
なお、テキストだけのメール作成（宛先・件名・本文をExcelから設定）は Excelからメール自動作成（Outlook連携） を参照。この記事では「Excelの表をメール本文にきれいに貼り付ける」に特化する。
実行前の準備
Outlookの起動を確認する
VBAからOutlookを操作するには、Outlookがインストール済みで、初回起動（プロファイル設定）が完了している必要がある。マクロ実行前にOutlookを起動しておくこと。
※ Outlookが起動していない場合、「実行時エラー ‘429’」が発生する。タスクバーにOutlookのアイコンがあることを確認すること。
シート構成を確認する（最小版）
最小版では、Excelの指定範囲をHTMLに変換してメール本文に挿入する。以下のような表があることを前提とする：
「Sheet1」シート（売上集計表の例）:
| A列 | B列 | C列 | D列 |
|---|---|---|---|
| 担当者 | 商品名 | 数量 | 金額 |
| 渡辺 | 商品A | 10 | 50,000 |
| 田中 | 商品B | 5 | 30,000 |
| 佐藤 | 商品C | 8 | 40,000 |
- 1行目はヘッダー
- 2行目以降がデータ
バックアップを取る
元データは変更されないが、念のためファイルのコピーを保存しておく。
Excelをマクロ有効ブック（.xlsm）で保存する
- 「ファイル」→「名前を付けて保存」
- ファイルの種類を「Excelマクロ有効ブック (*.xlsm)」に変更
- 保存
手順（コピペ → 実行まで約5分）
VBE（コードを書く画面）を開く
- Excelで
Alt + F11を押す - VBE（Visual Basic Editor）が開く
標準モジュールを挿入する
- VBEのメニュー →「挿入」→「標準モジュール」
- 白い画面（コードウィンドウ）が表示される
コードを貼り付けて実行する
- コードウィンドウに、下のコードをそのままコピペする
- Outlookが起動していることを確認する
Alt + F8→ マクロ名を選んで「実行」- Outlookに下書きメールが表示される
ボタンに割り当てれば毎回Alt+F8を押さなくて済む。方法は マクロをボタン1つで実行する方法 を参照。
コード（最小版）– 指定範囲をHTML化してメール本文に挿入
まずはこれだけで動く。Excelの指定範囲をHTMLテーブルに変換し、Outlookメール本文に挿入する。送信はしない（.Display で下書き表示のみ）。
'============================================================
' ■ Excelの表をHTMLに変換してOutlookメール本文に挿入（最小版）
' → 指定範囲をHTMLテーブルに変換し、下書きメールを作成
' → .Display で下書き表示のみ（送信しない）
'============================================================
Sub TableToMailMinimal()
'--- ★書き換えポイント ---
Dim sheetName As String
sheetName = "Sheet1" '← 表があるシート名
Dim tableRange As String
tableRange = "A1:D4" '← メール本文に挿入する範囲
Dim mailTo As String
mailTo = "example@example.com" '← 宛先メールアドレス
Dim mailSubject As String
mailSubject = "【売上集計表】今週の実績" '← メール件名
Dim mailBody As String
mailBody = "お疲れ様です。今週の売上集計表をお送りします。" '← 表の前に入れるメッセージ
'--- ★ここまで ---
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(sheetName)
Dim rng As Range
Set rng = ws.Range(tableRange)
'--- ExcelのセルをHTMLテーブルに変換
Dim tableHtml As String
tableHtml = RangeToHtmlTable(rng)
'--- Outlookメール作成
Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")
Dim olMail As Object
Set olMail = olApp.CreateItem(0) ' 0 = olMailItem
With olMail
.To = mailTo
.Subject = mailSubject
'--- ★重要：.Displayで署名を読み込んでからHTMLを挿入
.Display
'--- 既存のHTMLBody（署名含む）を取得
Dim existingHtml As String
existingHtml = .HTMLBody
'--- 表の前にメッセージを入れてHTMLを組み立て
Dim insertHtml As String
insertHtml = "<p>" & Replace(mailBody, vbCrLf, "<br>") & "</p>" & _
tableHtml & "<br>"
'--- <body の後に挿入（署名を保持）
Dim bodyPos As Long
bodyPos = InStr(1, existingHtml, "<body", vbTextCompare)
If bodyPos > 0 Then
Dim closeTag As Long
closeTag = InStr(bodyPos, existingHtml, ">")
.HTMLBody = Left(existingHtml, closeTag) & _
insertHtml & _
Mid(existingHtml, closeTag + 1)
Else
'--- <body>タグが見つからない場合はそのまま設定
.HTMLBody = "<html><body>" & insertHtml & "</body></html>"
End If
End With
MsgBox "下書きメールを作成しました。" & vbCrLf & _
"Outlookで内容を確認してから送信してください。", vbInformation
Set olMail = Nothing
Set olApp = Nothing
End Sub
'============================================================
' ■ セル範囲をHTMLテーブルに変換する関数
'============================================================
Function RangeToHtmlTable(rng As Range) As String
Dim html As String
Dim r As Long
Dim c As Long
Dim cellVal As String
html = "<table border='1' cellpadding='5' cellspacing='0' " & _
"style='border-collapse:collapse; font-family:Meiryo,sans-serif; font-size:10pt;'>"
For r = 1 To rng.Rows.Count
html = html & "<tr>"
For c = 1 To rng.Columns.Count
cellVal = rng.Cells(r, c).Text
If cellVal = "" Then cellVal = " "
'--- ヘッダー行（1行目）は太字・背景色付き
If r = 1 Then
html = html & "<td style='background-color:#4472C4; color:#FFFFFF; " & _
"font-weight:bold; padding:6px 10px; white-space:nowrap;'>" & _
cellVal & "</td>"
Else
html = html & "<td style='padding:4px 10px; white-space:nowrap;'>" & _
cellVal & "</td>"
End If
Next c
html = html & "</tr>"
Next r
html = html & "</table>"
RangeToHtmlTable = html
End Function
重要：このコードはメールを送信しない
.Display は下書きとしてメールウィンドウを開くだけ。内容を確認してからOutlook上で送信ボタンを押す。誤送信の心配がない安全設計。
書き換えポイント
| 変数 | 説明 | 初期値 |
|---|---|---|
| `sheetName` | 表があるシート名 | `”Sheet1″` |
| `tableRange` | メール本文に挿入する範囲 | `”A1:D4″` |
| `mailTo` | 宛先メールアドレス | `”example@example.com”` |
| `mailSubject` | メール件名 | `”【売上集計表】今週の実績”` |
| `mailBody` | 表の前に入れるメッセージ | `”お疲れ様です。…”` |
コードの流れ
- 指定範囲をHTMLテーブルに変換（
RangeToHtmlTable関数） - Outlookのメールオブジェクトを作成
.Displayで下書き表示（この時点で署名が自動挿入される）- 既存の
.HTMLBody（署名含む）を取得 タグの直後に表のHTMLを挿入（署名を保持）- 下書きメールが表＋署名付きで表示される
署名保持のポイント: .Display を先に実行することで、Outlookが自動挿入する署名を取得できる。その後で タグの直後にHTMLテーブルを挿入すれば、署名が消えない。自分は最初 .HTMLBody = tableHtml と直接代入して署名が消えてしまった。この方法に変えてから署名問題は解消した。
セル範囲の読み取りの仕組みは セルの転記を自動化する方法 と同じ技術を使っている。
コード（実務版）– 一覧表から宛先・件名を自動設定 + CC/BCC対応
実務では複数の担当者にそれぞれ異なる表を送る場面がある。一覧表から宛先・件名・表の範囲を読み取り、複数の下書きメールを一括作成する版。CC/BCCにも対応。
「送信一覧」シートのレイアウト：
| A列 | B列 | C列 | D列 | E列 | F列 | G列 |
|---|---|---|---|---|---|---|
| 宛先 | CC | BCC | 件名 | シート名 | 範囲 | ステータス |
| yamada@example.com | admin@example.com | 【東京】売上集計表 | 東京 | A1:D10 | ||
| suzuki@example.com | manager@example.com | 【大阪】売上集計表 | 大阪 | A1:D8 |
'============================================================
' ■ 一覧表から宛先・件名を読み取りメール一括作成（実務版）
' → 複数テーブル対応 + CC/BCC + ステータス記録
' → .Display で下書き表示のみ（送信しない）
'============================================================
Sub TableToMailAdvanced()
'--- ★書き換えポイント ---
Dim listSheet As String
listSheet = "送信一覧" '← 宛先一覧のシート名
Dim bodyMessage As String
bodyMessage = "お疲れ様です。集計表をお送りします。ご確認ください。"
'--- ★ここまで ---
Dim wsList As Worksheet
Set wsList = ThisWorkbook.Worksheets(listSheet)
Dim lastRow As Long
lastRow = wsList.Cells(wsList.Rows.Count, 1).End(xlUp).Row
If lastRow < 2 Then
MsgBox "送信一覧にデータがありません。" & vbCrLf & _
"A2セル以降に宛先を入力してください。", vbExclamation
Exit Sub
End If
Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")
Dim mailCount As Long
Dim errCount As Long
mailCount = 0
errCount = 0
Dim i As Long
For i = 2 To lastRow
'--- 宛先が空欄ならスキップ
If Trim(wsList.Cells(i, 1).Value) = "" Then
wsList.Cells(i, 7).Value = "スキップ（宛先なし）"
GoTo NextRow
End If
On Error GoTo ErrHandler
'--- 表のシートと範囲を取得
Dim dataSheetName As String
dataSheetName = Trim(wsList.Cells(i, 5).Value) ' E列：シート名
Dim dataRangeAddr As String
dataRangeAddr = Trim(wsList.Cells(i, 6).Value) ' F列：範囲
If dataSheetName = "" Or dataRangeAddr = "" Then
wsList.Cells(i, 7).Value = "スキップ（シート名or範囲が空）"
GoTo NextRow
End If
'--- 表のシートが存在するか確認
Dim wsData As Worksheet
On Error Resume Next
Set wsData = ThisWorkbook.Worksheets(dataSheetName)
On Error GoTo ErrHandler
If wsData Is Nothing Then
wsList.Cells(i, 7).Value = "エラー：シート「" & dataSheetName & "」が存在しない"
errCount = errCount + 1
GoTo NextRow
End If
'--- セル範囲をHTMLテーブルに変換
Dim rng As Range
Set rng = wsData.Range(dataRangeAddr)
Dim tableHtml As String
tableHtml = RangeToHtmlTable(rng)
'--- Outlookメール作成
Dim olMail As Object
Set olMail = olApp.CreateItem(0)
With olMail
.To = wsList.Cells(i, 1).Value ' A列：宛先
.Subject = wsList.Cells(i, 4).Value ' D列：件名
'--- CC/BCC
If Trim(wsList.Cells(i, 2).Value) <> "" Then
.CC = wsList.Cells(i, 2).Value ' B列：CC
End If
If Trim(wsList.Cells(i, 3).Value) <> "" Then
.BCC = wsList.Cells(i, 3).Value ' C列：BCC
End If
'--- .Displayで署名を読み込む
.Display
'--- 既存のHTMLBody（署名含む）を取得
Dim existingHtml As String
existingHtml = .HTMLBody
'--- 表の前にメッセージを入れてHTMLを組み立て
Dim insertHtml As String
insertHtml = "<p>" & Replace(bodyMessage, vbCrLf, "<br>") & "</p>" & _
tableHtml & "<br>"
'--- <body の後に挿入（署名を保持）
Dim bodyPos As Long
bodyPos = InStr(1, existingHtml, "<body", vbTextCompare)
If bodyPos > 0 Then
Dim closeTag As Long
closeTag = InStr(bodyPos, existingHtml, ">")
.HTMLBody = Left(existingHtml, closeTag) & _
insertHtml & _
Mid(existingHtml, closeTag + 1)
Else
.HTMLBody = "<html><body>" & insertHtml & "</body></html>"
End If
End With
wsList.Cells(i, 7).Value = "作成済み"
mailCount = mailCount + 1
Set olMail = Nothing
Set wsData = Nothing
On Error GoTo 0
NextRow:
Next i
MsgBox mailCount & " 通の下書きメールを作成しました。" & vbCrLf & _
"エラー：" & errCount & " 通" & vbCrLf & _
"G列にステータスを記録しました。" & vbCrLf & vbCrLf & _
"Outlookで内容を確認してから送信してください。", vbInformation, "完了"
Set olApp = Nothing
Exit Sub
ErrHandler:
wsList.Cells(i, 7).Value = "エラー：" & Err.Description
errCount = errCount + 1
Set olMail = Nothing
Set wsData = Nothing
On Error GoTo 0
Resume NextRow
End Sub
書き換えポイント
| 変数 | 説明 | 初期値 |
|---|---|---|
| `listSheet` | 宛先一覧のシート名 | `”送信一覧”` |
| `bodyMessage` | 表の前に入れるメッセージ | `”お疲れ様です。集計表をお送りします。…”` |
送信一覧シートの列構成
| 列 | 内容 | 必須 |
|---|---|---|
| A列 | 宛先メールアドレス | 必須 |
| B列 | CC | 任意（空欄可） |
| C列 | BCC | 任意（空欄可） |
| D列 | メール件名 | 必須 |
| E列 | 表があるシート名 | 必須 |
| F列 | 表の範囲（例: A1:D10） | 必須 |
| G列 | ステータス（自動記録） | 自動 |
コードの流れ
- 送信一覧を読み込み: シートから宛先・件名・表の範囲を取得
- バリデーション: 宛先が空欄 / シート名が空 / シートが存在しない場合はスキップ
- HTML変換: 指定シートの範囲をHTMLテーブルに変換
- メール作成:
.Displayで署名を取得し、HTMLテーブルを挿入 - CC/BCC設定: 空欄でなければ設定
- ステータス記録: G列に「作成済み」「スキップ」「エラー」を記録
このコードはすべて
.Display（下書き表示）で作成する。.Send は使わない安全設計。必ずOutlookで内容を確認してから手動で送信すること。
ボタンに割り当てれば毎回Alt+F8を押さなくて済む。方法は マクロをボタン1つで実行する方法 を参照。表の色分けは セルの値に応じて行を自動色分け で事前に設定しておくと、メール本文の見栄えがさらに良くなる。
よくある落とし穴5選
1. コピペで罫線が消えて見づらいメールになる
自分もこれで失敗した。Excelの表をCtrl+Cでコピーしてメール本文にCtrl+Vで貼り付けたら、罫線がすべて消えて数字だけが並んだメールになった。上司から「見づらい」と返信が来て、表の貼り付け方を見直すきっかけになった。
対策: 手動コピペではなく、VBAでHTMLテーブルに変換して .HTMLBody に挿入する。この記事のコードを使えば罫線と書式が保持される。
2. HTMLBodyに直接代入すると署名が消える
自分も最初は .HTMLBody = tableHtml と書いていた。表はきれいに入ったが、メール署名が完全に消えてしまった。署名なしのメールを送ってしまい、あとから署名を追加して再送する羽目になった。
対策: .Display で先にメールを表示し、Outlookが自動挿入した署名付きのHTMLを取得してから、 タグの直後にテーブルHTMLを挿入する。コード内で対策済み。
3. Outlookが起動していないとエラー429
原因: CreateObject("Outlook.Application") は、Outlookがインストール済みかつ初回起動済みでないと動かない。
対策: マクロ実行前にOutlookを起動しておく。タスクバーにOutlookのアイコンがあることを確認する。
4. セル結合した表を変換すると列がずれる
自分もセル結合した売上表をそのままHTML化したら、列数が合わなくてガタガタの表になった。結合セルは colspan / rowspan の処理が必要で、単純なHTMLテーブル変換では対応できない。
対策: HTML化する範囲のセル結合を事前に解除する。結合なしの表にしてからマクロを実行すれば、きれいにHTMLに変換できる。
5. 表の数値が文字列として入っている
原因: セルの書式が「文字列」になっていると、数値の右寄せや桁区切りが反映されない。
対策: HTML化する範囲のセル書式を「数値」や「通貨」に変更する。コードでは .Text プロパティを使っているので、セルに表示されているとおりの値がHTMLに入る。
FAQ
Q1: 表の範囲を自動で検出したい
CurrentRegion を使うと、データが入っている連続範囲を自動検出できる：
Dim rng As Range
Set rng = ws.Range("A1").CurrentRegion
Q2: 表だけでなくグラフも貼り付けたい
グラフをメール本文に貼り付けるには、グラフを画像として保存し .Attachments.Add で添付してからHTMLの
Q3: 表のスタイル（フォント・色）をもっとカスタマイズしたい
RangeToHtmlTable 関数内のスタイルを変更する。例えばヘッダーの背景色を変えるなら：
'--- ヘッダー背景色を緑に変更
html = html & "<td style='background-color:#70AD47; color:#FFFFFF; ...'>"
表に事前に色分けを設定しておくと見栄えが良くなる。セルの値に応じて行を自動色分け を参照。
Q4: 送信前に本文をプレビューで確認したい
.Display を使っているので、Outlookに下書きメールが表示される。内容を確認してから送信ボタンを押せばよい。この記事のコードはすべて .Display で下書き表示する安全設計。
Q5: 抽出したデータだけをメール本文に貼り付けたい
条件抽出してから表をメール本文に挿入する流れ。まず 複数条件でデータを抽出してまとめる方法 で抽出結果を別シートにまとめ、その範囲を tableRange に指定すれば、抽出結果だけがメール本文に入る。
まとめ
- Excel の指定範囲を
RangeToHtmlTable関数でHTMLテーブルに変換できる（最小版） .Display→ 署名取得 →タグ直後にHTML挿入で署名を保持できる- 一覧表から宛先・件名・範囲を読み取り複数メールを一括作成できる（実務版）
- すべて
.Display（下書き表示）で安全。.Sendは使わない
関連記事
- Excelからメール自動作成（Outlook連携） — テキストメールの基本。表が不要な場合はこちら
- ExcelファイルをPDFに一括変換 — 表をPDFで添付したい場合
- マクロをボタン1つで実行する方法 — メール作成マクロをボタンに割り当て
次にやりたくなること
- 一覧表からExcelテンプレートに差し込み印刷する方法: メール本文への表挿入の応用。テンプレートに値を差し込んで印刷・PDF化
- ExcelファイルをPDFに一括変換: 表をPDFで添付する方法。メール本文が長くなりすぎる場合はPDF添付が適切
メール本文に表がきれいに入ると、受け取る側の印象がまるで変わる。まずは最小版で「Excelの表がそのままメールに入る」感覚を体験してみてほしい。
コメント