VBA - 将多个 Excel 范围作为图像粘贴到 Outlook 中

VBA - 将多个 Excel 范围作为图像粘贴到 Outlook 中

尝试创建一封 Outlook 电子邮件,其中将 Excel 范围粘贴为电子邮件中的 jpg,以及前后的文本。类似:

文本

图片 1

图片 2

更多文本

但是,我不知道如何将 Excel 范围转换为图像并将其粘贴到 Outlook 电子邮件中,而不会覆盖那里的文本。当前代码如下(匿名),重点关注 .HTMLBody 部分。感觉这应该很简单,但我无法弄清楚确切的代码。

Sub GenerateEmail()
 
  ' Declare variables
  Dim outlookApp As Object
  Dim MItem As Object
  Dim Recipients As String
  Dim Subject As String
  Dim Body1 As String
  Dim Body2 As String
  Dim ws As Worksheet
  Dim EmailList As Range
  Dim Cell As Range
  Dim table1 As Range
  Dim table2 As Range
  Dim ExcRng As Range
  
 
  ' Set the email subject and body
  Subject = "Subject"
  Body1 = Sheet1.Range("B11")
  Body2 = Sheet1.Range("B12")
 
  ' Set the range that includes the list of email addresses
  Set EmailList = Sheet1.Range("b11:b11")
  
  ' Copy the range as an image and paste it into the email
  Set ws = ThisWorkbook.Sheets("sheet1")
  Set table1 = ThisWorkbook.Sheets("sheet2").Range("A1:I21")
  Set table2 = ThisWorkbook.Sheets("sheet3").Range("A4:W41")
  table1.Copy
  table2.Copy
 
  ' Create a new Outlook email
  Set outlookApp = CreateObject("Outlook.Application")
  Set MItem = outlookApp.CreateItem(olMailItem)
 
  ' Add the recipients, subject, and body to the email
With MItem
    .To = ws.Range("G4")
    .Subject = ws.Range("B7")
    
    'Add message before ranges
    .HTMLBody = ws.Range("B9") & "<br>" & "<br>" & ws.Range("B10") _
    **& RangeToJPG(table2) _
    & RangeToJPG(table1) _**
    & "<br>" & "<br>" & "<br>" & "<br>" & ws.Range("B11")
    
    .Display
End With

Set Message = Nothing
Set Email = Nothing

End Sub

对于 RangetoJPG,我尝试使用另一个用户的以下代码。但是,它会为每个图像创建一个新的电子邮件,而我并不想这样做。我无法确定如何将所有内容保留在同一个 Outlook 电子邮件项目中。

Function RangeToJPG(rng As Range)

'Copy range of interest
rng.Copy

'Open a new mail item
Dim outlookApp As Outlook.Application
Set outlookApp = CreateObject("Outlook.Application")
Dim OutMail As Outlook.MailItem
Set OutMail = outlookApp.CreateItem(olMailItem)

'Get its Word editor
OutMail.Display
Dim wordDoc As Word.Document
Set wordDoc = OutMail.GetInspector.WordEditor

'To paste as picture
wordDoc.Range.PasteAndFormat wdChartPicture

End Function

相关内容