hyaku outlook 複数セル

' ここから

Sub CopyRangeValuesToOutlookBody()
Dim olApp As Object
Dim olMail As Object
Dim rng As Range
Dim htmlBody As String
Dim row As Range
Dim cell As Range

' Outlookアプリケーションのインスタンスを取得
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If olApp Is Nothing Then
    Set olApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0

' メールオブジェクトを作成
Set olMail = olApp.CreateItem(0) ' 0はメールを表す定数

' セル範囲を指定
Set rng = ThisWorkbook.Sheets("Sheet1").Range("A1:C6") ' 適切なシート名とセル範囲を指定してください

' HTML形式で表を構築
htmlBody = "<table border='1' cellpadding='5'>"

' 各行に対して
For Each row In rng.Rows
    htmlBody = htmlBody & "<tr>"
    ' 各セルに対して
    For Each cell In row.Cells
        htmlBody = htmlBody & "<td>" & cell.Value & "</td>"
    Next cell
    htmlBody = htmlBody & "</tr>"
Next row

htmlBody = htmlBody & "</table>"

' Outlookの本文にHTML形式で表を貼り付け
olMail.HTMLBody = htmlBody

' メールを表示
olMail.Display

' コピー元のセルにフォーカスを戻す（オプション）
Application.CutCopyMode = False

End Sub