我试图通过VBA创建Outlook消息,我想在其中添加一串文本,一些表(使用RangetoHTML函数),一张图片,然后添加邮件签名。
我希望避免使用图片保存文件并通过附件添加(通常不会正确显示图像),即使用命令:
img src= 'img_name'.jpg
我希望可以使用以下代码完成,但到目前为止,我无法将图像放在文本之后和签名之前:
Sub Mail_Selection_Range_Outlook_Body()
'Variables
Dim r1 As Range
Dim r2 As Range
Dim s As String
Dim wordDoc As Word.Document
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'Get the text that will go on the mail body
s = ActiveWorkbook.Sheets("Plan2").Range("A1")
Set r1 = Sheets("Plan1").Range("A1:D4")
With OutMail
Set wordDoc = OutMail.GetInspector.WordEditor
.To = "example@test.com"
.Subject = "test"
.HTMLbody = s & RangetoHTML(r1) & .HTMLbody
'Set the range that will be pasted as an image
Set r2 = Sheets("Plan1").Range("A5:D9")
r2.CopyPicture Format:=xlPicture
OutMail.Display
'Set the position to paste the image
wordDoc.Application.Selection.Start = currentPosition
wordDoc.Application.Selection.End = wordDoc.Application.Selection.Start
'Paste the image
wordDoc.Application.Selection.Paste
.Close olSave
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
wordDoc.Application.Selection.Start = currentPosition
,则图像会在文本之前; .SendKeys "{END}"
放在wordDoc.Application.Selection.Start = currentPosition
; wordDoc.Application.Selection.Start = Len(.Body)
,则会在签名后放置图像!提前致谢。
答案 0 :(得分:0)
我实际上只能通过对代码进行一些调整来找到解决方法:
Sub Mail_Selection_Range_Outlook_Body()
'Variables
Dim r1 As Range
Dim r2 As Range
Dim s1 As String
Dim s2 As String
Dim wordDoc As Word.Document
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'Get the text that will go on the mail body
s1 = ActiveWorkbook.Sheets("Plan2").Range("A1")
s2 = ActiveWorkbook.Sheets("Plan2").Range("A2")
Set r1 = Sheets("Plan1").Range("A1:D4")
With OutMail
Set wordDoc = OutMail.GetInspector.WordEditor
.To = "example@test.com"
.Subject = "test"
.HTMLbody = s1 & RangetoHTML(r1) & .HTMLbody
'Set the range that will be pasted as an image
Set r2 = Sheets("Plan1").Range("A5:J22")
r2.CopyPicture Format:=xlPicture
OutMail.Display
'Set the position to paste the image
wordDoc.Application.Selection.Start = currentPosition
wordDoc.Application.Selection.End = wordDoc.Application.Selection.Start
'Paste the image
wordDoc.Application.Selection.Paste
.HTMLbody = s2 & .HTMLbody
.Close olSave
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
这样我仍然可以避免通过附件粘贴图像。
注意:为了将图片后面的文本放在一个新行中,我只需在参考单元格内的文本之前添加"<br>"
(在这种情况下,&#34; A1&#34; &#34; Plan2&#34;)。