ExcelVBAから、OUTLOOK起動して、Excelの表組みをメール本文に貼って送る。WordEditorでOutlook本文編集するのが、コツ

ExcelVBAから、OUTLOOK起動して、
Excelの表組みをメール本文に貼って送る。
WordEditorでOutlook本文編集するのが、コツ。

sample_excel_2_outlook

Public Sub do_OutlookMailSend(Optional mode = 4)
Dim wb As Workbook
Set wb = ActiveWorkbook

' 最大行数の取得　その１
'ir_m = wb.Sheets("out").Range("a1").SpecialCells(xlLastCell).Row

' 最大行数の取得　その２
ir_m = 9999
For ir = 1 To 1000
    If Trim(wb.Sheets("out").Cells(ir, 1).Value) = "" Then
        ir_m = ir
        Exit For
    End If
Next

' エクセルの表組みをコピー；　領域は適宜
wb.Sheets("out").Range("a1:f" & ir_m).Copy

Set myol = CreateObject("Outlook.Application")
Set myns = myol.Getnamespace("MAPI")
Set myfol = myns.getdefaultfolder(5)
myfol.Display

Set mymail = myol.createItem(0)
mymail.Display
Set ins = mymail.GetInspector

' WordEditorで、本文編集するのが、コツ
Set doc = ins.WordEditor

' ペイスト方式を選択
'mode is
'Const wdPasteHTML = 10
'Const wdPasteBitmap = 4
doc.Range.PasteSpecial DataType:=mode, Placement:=0

' オプション；画像での貼り付け時、拡縮と本文挿入
If mode = 4 Then
    doc.inlineShapes(1).ScaleWidth = 100
    doc.Range.InsertBefore "本文挿入" & vbCrLf & vbCrLf
End If

doc.Range.Font.Name = "ＭＳ Ｐゴシック"
doc.Range.Font.Size = 10.5

mymail.To = "[e-mail]"
mymail.Subject = "[" & Format(Now(), "YY MM DD") & "]" & "　メール送信テスト"
'mymail.body = ""

'''''
''mymail.send
'''''

Set mymail = Nothing
Set myfol = Nothing
Set myns = Nothing
Set myol = Nothing
Set wb = Nothing

End Sub

Private Sub CommandButton1_Click()
'画像で送る
Call do_OutlookMailSend
End Sub

Private Sub CommandButton2_Click()
'表組で送る
Call do_OutlookMailSend(10)
End Sub