[[20230529095821]]　『EXCEL VBAにて、EXCELの表一部をoutlookメール本普x（kana）　ページの最後に飛ぶ

『EXCEL VBAにて、EXCELの表一部をoutlookメール本文に貼り付け』（kana）

例えば、sheet1のA1からC3までの情報を本文に貼り付けたいです。
下記は現在のコードです。どうぞよろしくおねがいします。

    '自動メール
     Sheets("自動保存＆メール用").Select
 'outlookを起動する
    Dim toaddress, ccaddress, bccaddress As String  '変数設定：To宛先、cc宛先、bcc宛先
    Dim subject, mailBody, credit As String '変数設定：件名、メール本文、クレジット、添付
    Dim outlookObj As Outlook.Application    'Outlookで使用するオブジェクト生成
    Dim mailItemObj As Outlook.MailItem      'Outlookで使用するオブジェクト生成

 '差出人、本文、署名を取得する---
    toaddress = Range("B10").Value   'To宛先
    ccaddress = Range("B11").Value   'Cc宛先
    subject = Range("B12").Value & Format(Date, "yyyy/m/d")     '件名
    mailBody = Range("B13").Value    '本文
    credit = Range("B14").Value      'クレジット

'メールを作成して、差出人、本文、署名を入れ込む---

    Set outlookObj = CreateObject("Outlook.Application")
    Set mailItemObj = outlookObj.CreateItem(olMailItem)
    mailItemObj.BodyFormat = 2      'htmlテキストに変更
    mailItemObj.To = toaddress      'to宛先をセット
    mailItemObj.CC = ccaddress      'ccをセット
    mailItemObj.subject = subject   '件名をセット
    mailItemObj.Body = mailBody & vbCrLf & vbCrLf & credit   'メール本文 改行 改行 クレジット

  '---コード6｜メールを送信する---
    'mailItemObj.Save   '下書き保存
    mailItemObj.Display  'メール表示(ここでは誤送信を防ぐために表示だけにして、
    Sheets("自動保存＆メール用").Delete

＜使用 Excel：unknown、使用 OS：unknown ＞

 表の形のまま貼り付けるのは、なんかテクニックが必要だったような・・・
[[20221217123904]]　『Paste出来ない。VBAエラー』（みかん）
 ＞（稲葉） 2023/01/21(土) 12:57:15
 の投稿をちょっと試してもらって、わからないってことなら、中途半端に情報出さないで
 コード全文載せて、表の形がどうなっているのか含めて教えてもらえると手助けできるかもしれません。
（稲葉） 2023/05/29(月) 10:28:29

コメントありがとうございます。投稿みてみましたが、初心者の為よくわからず不明でした・・・
例えば、中段の mailItemObj.Body = mailBody &　～以降にsheets(sheets1).Range("A1:C3")にて試したところ、デバックエラーとなってしまいましたが、仮にRange(A1)にしたらうまく反映できておりました。恐らく指定の選択方法がおかしいのではと思いますがわかりません。。
（kana） 2023/05/29(月) 14:52:10

 ＞sheets(sheets1).Range("A1:C3")
 これが原文ママだとしたら、記述ルールと違うのでエラーになるのは当然だと思いますがそういう問題ではないということですか？
（.:*.ゆ ゅ） 2023/05/29(月) 15:55:57

 それでしたら、
 ＞（みかん）さん 2023/01/20(金) 10:01:13
 の投稿コードなら読み解けますか？
 こちらでも動くハズです。
（稲葉） 2023/05/29(月) 16:01:19

 mailBody = Range("B13").Value    '本文
でB13セルに何が入っているのかは知りませんが、
例えばA1:C3セルの値を繋げたいのであれば、
それぞれのセル値を＆で繋げばよろしいかと思います。

mailBody = Range("B13").Value & Range("A1").Value & Range("B1").Value & Range("C1").Value & .....
（ 'ふ'） 2023/05/29(月) 16:24:28

 あ、そういうこと？
 てっきり表の形で載せたいのかと思ってた・・・すません。
（稲葉） 2023/05/29(月) 17:39:10

ありがとうございました。表の形でしたらどうなりますか？
（kana） 2023/05/29(月) 18:45:32

 HTMLなら、下記の関数にRangeオブジェクト渡せば大丈夫だと思う。
 かたくなに全文と表の形載せてくれないねぇ。

 例
 mailBody = GetTableRange(Sheets("Sheet1").Rnage("A1:C1"))

    '//指定範囲をHTMファイルで出力し、文字列として取得
    Function GetTableRange(ByVal r As Range) As String
        Dim ws As Worksheet:    Set ws = r.Parent
        Dim wb As Workbook:     Set wb = ws.Parent
        Dim tmpPATH As String: tmpPATH = CreateObject("Wscript.Shell").SpecialFolders("DeskTop") & "\tmp.htm"
        Dim tmpTable As String
        If Dir(tmpPATH) <> "" Then Kill tmpPATH
        wb.PublishObjects.Add(xlSourceRange, tmpPATH, ws.Name, r.Address, xlHtmlStatic).Publish True
        '■//テキストストリームで取得
        tmpTable = CreateObject("Scripting.FileSystemObject").OpenTextFile(tmpPATH, 1).ReadAll
        tmpTable = Replace(tmpTable, "align=center", "align=Left") '表全体を左寄せに
        tmpTable = Replace(tmpTable, "General", "Left")            '表内の文字を左寄せに
        GetTableRange = tmpTable
        Kill tmpPATH
    End Function
（稲葉） 2023/05/29(月) 19:00:49

横からですが何点か。

■１
＞デバックエラー
コンパイルエラーの間違いじゃないですか？
（コンパイルエラーは構文として正しくないので、そもそも実行できてない状態です）

＞中段の～
回答者側では画面が見えませんから、横着せず全部を提示された方がお互い誤解がなくてよいと思います。

■２
私もてっきり、表を貼り付けたいという意味かなと思ったんですが違うんですかね。

表を貼り付けるという意味であれば、↓を参考にすると

 【参考】
https://pineplanter.moo.jp/non-it-salaryman/2022/01/07/vba-table-outlook/

↓みたいなことでよいようにおもいます。（変数盛沢山は好きじゃないんで適宜整理しました）

    Sub テキトー()
        Stop 'ブレークポイントの代わり
         Dim mailItemObj As Outlook.MailItem
         Set mailItemObj = CreateObject("Outlook.Application").CreateItem(olMailItem)

         With Sheets("自動保存＆メール用")
            mailItemObj.BodyFormat = 2      'htmlテキストに変更
            mailItemObj.To = .Range("B10").Value     'to宛先をセット
            mailItemObj.CC = .Range("B11").Value      'ccをセット
            mailItemObj.Subject = .Range("B12").Value & Format(Date, "yyyy/m/d")   '件名をセット

            mailItemObj.Display

            .Range("A1:C3").Copy
            mailItemObj.GetInspector().WordEditor.Windows(1).Selection.TypeText .Range("B13").Value & vbCrLf    'メール本文 改行
            mailItemObj.GetInspector().WordEditor.Windows(1).Selection.Paste
            mailItemObj.GetInspector().WordEditor.Windows(1).Selection.TypeText vbCrLf & .Range("B14").Value

            '.Delete
        End With
    End Sub

 ※Displayする前に操作する方法がありそうですが、ちょっと調べた限りではわかりませんでした。

（もこな２） 2023/05/29(月) 20:54:52

コメント返信：

[ 一覧(最新更新順) ]

[[20230529095821]] 『EXCEL VBAにて、EXCELの表一部をoutlookメール本普x（kana） ページの最後に飛ぶ

[[20230529095821]]　『EXCEL VBAにて、EXCELの表一部をoutlookメール本普x（kana）　ページの最後に飛ぶ