完成イメージ（Before / After）
Before（手動コピペ → 書式崩れ）
| A | B | C | |
|---|---|---|---|
| 1 | 日付 | 品目 | 数量 |
| 2 | 2026/04/15 | 商品A | 150 |
| 3 | 2026/04/16 | 商品B | 230 |
| 4 | 2026/04/17 | 商品C | 180 |
メールに貼り付けると罫線・背景色が消え、スクショで対処する手間が毎回発生。
After（VBAでHTML変換 → そのまま挿入）
| A | B | C | |
|---|---|---|---|
| 1 | 日付 | 品目 | 数量 |
| 2 | 2026/04/15 | 商品A | 150 |
| 3 | 2026/04/16 | 商品B | 230 |
| 4 | 2026/04/17 | 商品C | 180 |
VBAでHTML化すると、罫線・背景色・書式がそのまま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対応
表のHTML変換と署名保持の仕組みが分かると、「あとは一覧から宛先を読み取れば全自動化できる」と気づく。最小版で手応えをつかんだら、そのまま実務版に進んでほしい。
実務では複数の担当者にそれぞれ異なる表を送る場面がある。一覧表から宛先・件名・表の範囲を読み取り、複数の下書きメールを一括作成する版。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に入る。
VBAで貼り付けた表の罫線がメールに反映されないときの対処法
「メールを送ったら表の罫線が消えている」という場合、原因はHTMLテーブルのborderスタイルが設定されていないことだ。
コメント