Excel电子邮件文本，图像，文本，图像，文本，签名 [英] Excel Email Text, Image, Text, Image, Text, Signature
问题描述
经过几天的尝试，我承认失败了.我在Excel中工作，想要自动以特定格式起草电子邮件.我在这里和Google上进行了搜索，找不到任何格式为-的电子邮件:-
After a couple of days trying I have admitted defeat. I am working in Excel and want to automatically draft an email in a specific format. I have search on here and google and can't find anything where an email is in this format: -
- 单词
- 图片
- 单词
- 图片
- 单词
- 签名
我找到了我用来建造我的文字，图像，图像和签名的东西.
I have found ones that are words, image, image and signature which i have used to build mine.
这就是我正在做的事情的样子:-
This is how it is appearing with what i am doing: -
这是它的外观:-
我已将我尝试过的所有内容都留在注释部分.
I have left in all the things I have tried as commented out sections.
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是较小的表.
rng is the larger table and rng2 is the smaller table.
.Cells(5,2)到(8,2)在rng之前，(10,2)在rng之后和rng2之前，然后(12,2)将在rng2之后并且在签名之前.
.Cells(5,2) through to (8,2) go before rng and (10,2) goes after rng and before rng2 then (12,2) would go after rng2 and before the signature.
任何帮助将不胜感激.
谢谢
推荐答案
请尝试下一种方法.很难将 WordEditor 与html混合使用，至少，我没有这样做，因为我不知道如何/是否可以做到这一点.您需要的所有内容(我都知道)都可以使用 WordEditor 对象或使用 PropertyAccessor 的html完成并链接到图片路径.我仅在您改编的代码中使用 WordEditor :
Please, try the next approach. It is difficult to mix WordEditor with html, at least, I did not do it an I do not know how/if it can be done. Everything (I understood) you need can be done using WordEditor object or html using PropertyAccessor and link to picture paths. I am using in your adapted code only 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
请对其进行测试并发送一些反馈.
Please, test it and send some feedback.
这篇关于Excel电子邮件文本，图像，文本，图像，文本，签名的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
