按顺序创建包含内容的电子邮件：文本、图像、文本、图像、文本、签名答案

【问题标题】：Create email with contents in order: Text, Image, Text, Image, Text, Signature按顺序创建包含内容的电子邮件：文本、图像、文本、图像、文本、签名
【发布时间】：2021-02-09 07:01:30
【问题描述】：

我正在使用 Excel。我想以特定格式起草一封电子邮件。

我在这种格式的电子邮件中找不到任何内容：

单词
图片
单词
图片
单词
签名

我找到了我用来构建我的文字、图像、图像和签名的那些。

它是这样显示的：

它应该是这样的：

我将所有我尝试过的内容都保留为注释掉的部分。

Sub EmailGenerate()
    
    Dim objOutApp As Object, objOutMail As Object
    Dim strBody As String, strSig As String, strEnd As String, strBody2 As String
    Dim rng As Range, rng2 As Range
    Dim r As Long, r2 As Long
    Dim wdDoc As Word.Document
    Dim Selection As Word.Selection
    Dim Selection2 As Word.Selection
     
    r = shEmail.Cells(Rows.Count, 15).End(xlUp).Row
    Set rng = shEmail.Range("K1:" & Cells(r, 21).Address)
    
    r2 = shEmail.Cells(Rows.Count, 23).End(xlUp).Row
    Set rng2 = shEmail.Range("W1:" & Cells(r2, 29).Address)
    
    Set objOutApp = CreateObject("Outlook.Application")
    Set objOutMail = objOutApp.CreateItem(0)
    Set wdDoc = objOutMail.GetInspector.WordEditor
     
    With objOutMail
        'If sent on behalf of another email address
        ' .SentOnBehalfOfName = ""
        'Setting the email conditions
        .To = shEmail.Cells(1, 2).Value
        .CC = shEmail.Cells(2, 2).Value
        .BCC = ""
        'Checks all email names
        .Recipients.ResolveAll
        .Subject = shEmail.Cells(4, 2).Value
        'This must be visible to get the default signature
        .Display
        'Get the html code from the signature
        strSig = .htmlbody
        'This is what the email body should say
      
       ' rng.Copy
       ' wdDoc.Application.Selection.Start = Len(strBody)
       ' wdDoc.Application.Selection.End = wdDoc.Application.Selection.Start
       ' wdDoc.Application.Selection.PasteAndFormat (wdChartPicture)
       ' wdDoc.Content.InsertParagraphAfter
       ' rng2.Copy
       ' wdDoc.Application.Selection.Start = Len(strBody) + Len(strBody2)
       ' wdDoc.Application.Selection.End = wdDoc.Application.Selection.Start
       ' wdDoc.Application.Selection.PasteAndFormat (wdChartPicture)
      
       ' rng1.Copy
       ' wdDoc.Paragraphs(2).Range.PasteSpecial , , , , wdPasteBitmap
      
        rng.Copy
        wdDoc.Content.InsertParagraphBefore
        wdDoc.Paragraphs(2).Range.PasteSpecial , , , , wdPasteBitmap
        wdDoc.Content.InsertParagraphAfter
      
        strBody = "<Body style=font-size:11pt;font-family:Calibri>" & _
          shEmail.Cells(5, 2).Value & "</p>" & _
          "<p>" & "</p>" & _
          "<p>" & shEmail.Cells(6, 2).Value & "</p>" & _
          "<p>" & shEmail.Cells(7, 2).Value & "</p>" & _
          "<p>" & "</p>" & _
          "<p>" & shEmail.Cells(8, 2).Value & "</p>"
          
        strBody2 = "<Body style=font-size:11pt;font-family:Calibri>" & _
          shEmail.Cells(10, 2).Value & "</p>" & _
          "<p>" & "</p>"
       
        rng2.Copy
        wdDoc.Content.InsertParagraphBefore
        wdDoc.Paragraphs(1).Range.PasteSpecial , , , , wdPasteBitmap
        wdDoc.Content.InsertParagraphAfter
        
        objOutMail.htmlbody = strBody2 & _
          .htmlbody
         
        ' rng2.Copy
        ' wdDoc.Application.Selection.Start = Len(strBody) + Len(strBody2)
        ' wdDoc.Application.Selection.End = wdDoc.Application.Selection.Start
        ' wdDoc.Application.Selection.PasteAndFormat (wdChartPicture)
    
        'Combines the email with image and the signature
        objOutMail.htmlbody = strBody & _
          .htmlbody
      
        'Automatically sends the email, should pop up briefly.
        '.Send
    
    End With
    
    On Error GoTo 0
    Set objOutMail = Nothing
    Set objOutApp = Nothing
     
End Sub

rng 是较大的表，rng2 是较小的表。

.Cells(5,2) 到 (8,2) 位于 rng 之前，(10,2) 位于 rng 之后和 rng2 之前，那么 (12,2) 将位于 rng2 之后和签名之前。

【问题讨论】：

Steven hi - 信息很清楚，但我不确定确切的问题是什么：你能帮我一下吗？谢谢
您好约翰，感谢您的回复。很抱歉我的问题不是很清楚。我想在我的代码错误的地方得到帮助。或指导以更好的方式将其转换为我需要的格式。我在代码下方添加了一个简短的解释，以显示与代码保持一致的位置。我希望这是有道理的。谢谢
一个快速观察 - 你可能知道，但如果不是 "<p>" & "</p>" 不会给你换行，你可以试试 </br>
我不知道，谢谢。
months 和 completed - 您正在寻找超链接？如果是这样，您将如何为此构建 html？

标签： excel vba outlook ms-word

【解决方案1】：

请尝试下一种方法。很难将WordEditor 与 html 混合，至少，我没有这样做，我不知道如何/是否可以做到。您需要的一切（我理解）都可以使用WordEditor 对象或使用PropertyAccessor 的html 并链接到图片路径来完成。我只在您改编的代码中使用WordEditor:

Sub EmailGenerate()
 Dim objOutApp As Object, objOutMail As Object
 Dim rng As Range, rng2 As Range, shEmail As Worksheet
 Dim r As Long, r2 As Long
 Dim wdDoc As Word.document, wdRange As Word.Range
 
 Set shEmail = ActiveSheet 'use here your necessary sheet
 
 r = shEmail.cells(Rows.count, 15).End(xlUp).row
 Set rng = shEmail.Range("K1:" & cells(r, 21).Address)

 r2 = shEmail.cells(Rows.count, 23).End(xlUp).row
 Set rng2 = shEmail.Range("W1:" & cells(r2, 29).Address)

 Set objOutApp = CreateObject("Outlook.Application")
 Set objOutMail = objOutApp.CreateItem(0)
 Set wdDoc = objOutMail.GetInspector.WordEditor
  
 With objOutMail
    'If sent on behalf of another email address
    '.SentOnBehalfOfName = ""
    'Setting the email conditions
    .To = shEmail.cells(1, 2).Value
    .cc = shEmail.cells(2, 2).Value
    .BCC = ""
    'Checks all email names
    .Recipients.ResolveAll
    .subject = shEmail.cells(4, 2).Value
    'This must be visible to get the default signature
    .display 'Please, look here if its appearance is what you need.
    
    'Declare the string variables to be used:
    Dim strFrst As String, strSec As String, strThird As String, strF As String
    
    'Give values to the strings (they can take the values from the sheet...)
    strFrst = "Hello All!" & vbCrLf & vbCrLf
    strSec = "Please, receive the picture you requested:" & vbCrLf & vbCrLf
    strThird = "And the second picture is following:" & vbCrLf & vbCrLf
    strF = "The last necessary string is here..." & vbCrLf
    
    'Write the first two text lines:________________
    wdDoc.Paragraphs(1).Range.InsertAfter (strFrst)
    wdDoc.Paragraphs(2).Range.InsertAfter (vbCrLf) 'insert an empty line
    wdDoc.Paragraphs(3).Range.InsertAfter (strSec)
    '_______________________________________________
    
    'Embed the first picture__________________________________________
    rng.Copy
    wdDoc.Paragraphs(5).Range.PasteSpecial , , , , wdPasteBitmap
    '_________________________________________________________________
    
    wdDoc.Paragraphs(5).Range.InsertAfter (vbCrLf) 'empty line after first picture
    
    'insert the third string:_______________________
    wdDoc.Paragraphs(6).Range.InsertAfter (strThird)
    '_______________________________________________
      
    'Embed the second picture___________________________________
    rng2.Copy
    wdDoc.Paragraphs(8).Range.PasteSpecial , , , , wdPasteBitmap
    '___________________________________________________________
    
    'insert the fourth string:__________________
    wdDoc.Paragraphs(8).Range.InsertAfter (strF)
    '___________________________________________
    
    
    'Automatically sends the email, should pop up briefly.
    '.Send
 End With
End Sub

请进行测试并发送一些反馈。

【讨论】：

@Steven Byrne：这仅表示我想向您展示一种（仅）与WordEditor 打交道的方法，以便在您需要的地方插入图片或字符串。如果不够清楚，我将修改代码以在末尾插入另一个字符串...
@Steven Byrne：你的意思是你先有图片然后有文字？如果是，这在我的情况下不会发生...您是否尝试了代码原样，还是进行了一些（可能是小的）调整？请在rng.Copy 上打断线，然后逐行运行代码（按 F8），看看发生了什么...
我不能再呆下去了……我应该在几分钟前离开我的办公室。我们可以在我在家的几个小时后继续讨论。
@Steven Byrne：请测试更新后的代码。我创建了一个签名并开始使用WordEditor 对象。它按我的想法工作......请在测试后发送一些反馈。
@Steven Byrne：很高兴我能帮上忙！我在玩WordEditor 的过程中也学到了一些东西。不知道原因，添加一个空行 (vbCrLf) 不会添加这样一个可见的行，但否则第一段将从邮件页面上侧和签名行之间的初始空间“占用”一行。当你需要这样一个空行时，你必须创建另一个段落......