我的电子表格中包含Q列中的电子邮件收件人列表以及F列中的文件附件列表：
Column f Column Q
File1.xls email1
File2.xls email2
我的代码应该遍历Q列中的所有电子邮件，并向收件人发送一封包含F列相应文件附件的电子邮件。
这一点工作正常，但我也想从我的Excel工作簿中复制一个范围并将其粘贴到每封电子邮件的电子邮件正文中。
excel工作表范围不会正确粘贴到电子邮件正文中。它产生了以下结果：
Good afternoon,
Please see attached an announcement of the spot buy promotion for week 21, 2017.
Please can you confirm within 24 hours.
- HarviestounBrewery.xlsx
Kind regards / Mit freundlichen Grüßen,
The Food Specials Team
<html xmlns:o="urn:schemas-microsoft-com:office:office"
xmlns:x="urn:schemas-microsoft-com:office:excel"
xmlns="http://www.w3.org/TR/REC-html40">
<head>
<meta http-equiv=Content-Type content="text/html; charset=windows-1252">
<meta name=ProgId content=Excel.Sheet>
<meta name=Generator content="Microsoft Excel 15">
<link rel=File-List href="28-02-17%2017-37-22_files/filelist.xml">
<style id="Sheet66_4180_Styles">
<!--table
{mso-displayed-decimal-separator:"\.";
mso-displayed-thousand-separator:"\,";}
.xl154180
{padding-top:1px;
padding-right:1px;
padding-left:1px;
mso-ignore:padding;
color:black;
font-size:10.0pt;
font-weight:400;
font-style:normal;
text-decoration:none;
font-family:Arial, sans-serif;
mso-font-charset:0;
mso-number-format:General;
text-align:general;
vertical-align:bottom;
mso-background-source:auto;
mso-pattern:auto;
white-space:nowrap;}
.xl634180
{padding-top:1px;
padding-right:1px;
padding-left:1px;
mso-ignore:padding;
color:#595959;
font-size:14.0pt;
font-weight:400;
font-style:normal;
text-decoration:underline;
text-underline-style:single;
font-family:Calibri, sans-serif;
mso-font-charset:0;
mso-number-format:General;
text-align:left;
vertical-align:middle;
background:#F2F2F2;
mso-pattern:black none;
white-space:nowrap;}
.xl644180
{padding-top:1px;
padding-right:1px;
padding-left:1px;
mso-ignore:padding;
color:#595959;
font-size:14.0pt;
font-weight:400;
font-style:normal;
text-decoration:underline;
text-underline-style:single;
font-family:Calibri, sans-serif;
mso-font-charset:0;
mso-number-format:General;
text-align:general;
vertical-align:middle;
background:#F2F2F2;
mso-pattern:black none;
white-space:nowrap;}
.xl654180
{padding-top:1px;
padding-right:1px;
padding-left:1px;
mso-ignore:padding;
color:#595959;
font-size:14.0pt;
font-weight:400;
font-style:normal;
text-decoration:underline;
text-underline-style:single;
font-family:Calibri, sans-serif;
mso-font-charset:0;
mso-number-format:"Short Date";
text-align:left;
vertical-align:middle;
background:#F2F2F2;
mso-pattern:black none;
white-space:nowrap;}
.xl664180
{padding-top:1px;
padding-right:1px;
padding-left:1px;
mso-ignore:padding;
color:#595959;
font-size:14.0pt;
font-weight:400;
font-style:normal;
text-decoration:none;
font-family:Calibri, sans-serif;
mso-font-charset:0;
mso-number-format:General;
text-align:general;
vertical-align:middle;
background:#F2F2F2;
mso-pattern:black none;
white-space:nowrap;}
-->
</style>
</head>
<body>
<!--[if !excel]> <![endif]-->
<!--The following information was generated by Microsoft Excel's Publish as Web
Page wizard.-->
<!--If the same item is republished from Excel, all information between the DIV
tags will be replaced.-->
<!----------------------------->
<!--START OF OUTPUT FROM EXCEL PUBLISH AS WEB PAGE WIZARD -->
<!----------------------------->
<div id="Sheet66_4180" align=left x:publishsource="Excel">
<table border=0 cellpadding=0 cellspacing=0 width=1763 style='border-collapse:
collapse;table-layout:fixed;width:1327pt'>
<col width=65 span=14 style='mso-width-source:userset;mso-width-alt:2377;
width:49pt'>
<col width=123 style='mso-width-source:userset;mso-width-alt:4498;width:92pt'>
<col width=65 style='width:49pt'>
<col width=135 style='mso-width-source:userset;mso-width-alt:4937;width:101pt'>
<col width=130 style='mso-width-source:userset;mso-width-alt:4754;width:98pt'>
<col width=65 span=5 style='width:49pt'>
<col width=75 style='mso-width-source:userset;mso-width-alt:2742;width:56pt'>
<tr height=25 style='height:18.75pt'>
<td height=25 class=xl634180 colspan=2 width=130 style='height:18.75pt;
width:98pt'>Supplier</td>
<td class=xl644180 width=65 style='width:49pt'><u style='visibility:hidden;
mso-ignore:visibility'> </u></td>
<td class=xl644180 width=65 style='width:49pt'><u style='visibility:hidden;
mso-ignore:visibility'> </u></td>
<td class=xl644180 width=65 style='width:49pt'><u style='visibility:hidden;
mso-ignore:visibility'> </u></td>
<td class=xl644180 width=65 style='width:49pt'><u style='visibility:hidden;
mso-ignore:visibility'> </u></td>
<td class=xl644180 colspan=2 width=130 style='width:98pt'>Contact Name</td>
<td class=xl644180 width=65 style='width:49pt'><u style='visibility:hidden;
mso-ignore:visibility'> </u></td>
<td class=xl644180 width=65 style='width:49pt'><u style='visibility:hidden;
mso-ignore:visibility'> </u></td>
<td class=xl644180 colspan=2 width=130 style='width:98pt'>Contact Email</td>
<td class=xl644180 width=65 style='width:49pt'><u style='visibility:hidden;
mso-ignore:visibility'> </u></td>
<td class=xl644180 width=65 style='width:49pt'><u style='visibility:hidden;
mso-ignore:visibility'> </u></td>
<td class=xl654180 width=123 style='width:92pt'>Delivery Date</td>
<td class=xl634180 width=65 style='width:49pt'><u style='visibility:hidden;
mso-ignore:visibility'> </u></td>
<td class=xl644180 width=135 style='width:101pt'>Notice</td>
<td class=xl644180 width=130 style='width:98pt'><u style='visibility:hidden;
mso-ignore:visibility'> </u></td>
<td class=xl644180 width=65 style='width:49pt'>Action</td>
<td class=xl664180 width=65 style='width:49pt'> </td>
<td class=xl644180 width=65 style='width:49pt'>Open</td>
<td class=xl664180 width=65 style='width:49pt'> </td>
<td class=xl664180 width=65 style='width:49pt'> </td>
<td class=xl644180 width=75 style='width:56pt'>Remove</td>
</tr>
<![if supportMisalignedColumns]>
<tr height=0 style='display:none'>
<td width=65 style='width:49pt'></td>
<td width=65 style='width:49pt'></td>
<td width=65 style='width:49pt'></td>
<td width=65 style='width:49pt'></td>
<td width=65 style='width:49pt'></td>
<td width=65 style='width:49pt'></td>
<td width=65 style='width:49pt'></td>
<td width=65 style='width:49pt'></td>
<td width=65 style='width:49pt'></td>
<td width=65 style='width:49pt'></td>
<td width=65 style='width:49pt'></td>
<td width=65 style='width:49pt'></td>
<td width=65 style='width:49pt'></td>
<td width=65 style='width:49pt'></td>
<td width=123 style='width:92pt'></td>
<td width=65 style='width:49pt'></td>
<td width=135 style='width:101pt'></td>
<td width=130 style='width:98pt'></td>
<td width=65 style='width:49pt'></td>
<td width=65 style='width:49pt'></td>
<td width=65 style='width:49pt'></td>
<td width=65 style='width:49pt'></td>
<td width=65 style='width:49pt'></td>
<td width=75 style='width:56pt'></td>
</tr>
<![endif]>
</table>
</div>
<!----------------------------->
<!--END OF OUTPUT FROM EXCEL PUBLISH AS WEB PAGE WIZARD-->
<!----------------------------->
</body>
</html>
继承我的代码：
Sub Send_Email2()
Dim answer As Integer
answer = MsgBox("Are you sure you want to Send All Announcements?", vbYesNo + vbQuestion, "Notice")
If answer = vbNo Then
Exit Sub
Else
Dim rnBody As Range
Dim Data As DataObject
Set rnBody = Worksheets(1).Range("N3")
rnBody.Copy
Dim Maildb As Object
Dim MailDoc As Object
Dim Body As Object
Dim Session As Object
Dim i As Long
Dim j As Long
Dim server, mailfile, user, usersig As String
Dim LastRow As Long, ws As Worksheet
LastRow = Worksheets(1).Range("F" & Rows.Count).End(xlUp).Row 'Finds the last used row
j = 18
'Start a session of Lotus Notes
Set Session = CreateObject("Notes.NotesSession")
'This line prompts for password of current ID noted in Notes.INI
Set Maildb = Session.CurrentDatabase
Set stream = Session.CreateStream
' Turn off auto conversion to rtf
Session.ConvertMime = False
With ThisWorkbook.Worksheets(1)
For i = 18 To LastRow
'Create the Mail Document
Session.ConvertMime = False ' Do not convert MIME to rich text
Set MailDoc = Maildb.CreateDocument
Call MailDoc.ReplaceItemValue("Form", "Memo")
'Set From
Call MailDoc.ReplaceItemValue("Principal", "Food Specials <mailto:Food.Specials@Lidl.co.uk>")
Call MailDoc.ReplaceItemValue("ReplyTo", "Food.Specials@Lidl.co.uk")
Call MailDoc.ReplaceItemValue("DisplaySent", "Food.Specials@Lidl.co.uk")
'Set the Recipient of the mail
Call MailDoc.ReplaceItemValue("SendTo", Range("Q" & i).value)
'Call MailDoc.ReplaceItemValue("CopyTo", "food.specials@lidl.co.uk")
'Set subject of the mail
Call MailDoc.ReplaceItemValue("Subject", "Promotion Announcement for week " & Range("I8").value & ", " & Range("T8").value & " - Confirmation required")
'Create and set the Body content of the mail
Set Body = MailDoc.CREATERICHTEXTITEM("Body")
If Range("I10").value <> "" Then
Call Body.APPENDTEXT("Good " & Range("A1").value & "," & vbNewLine & vbNewLine _
& "Please see attached an announcement of the spot buy promotion for week " & Range("I8").value & ", " & Range("T8").value & "." & vbNewLine & vbNewLine _
& "Please can you confirm within 24 hours." & vbNewLine & vbNewLine _
& Range("I10").value & vbNewLine)
Else
Call Body.APPENDTEXT("Good " & Range("A1").value & "," & vbNewLine & vbNewLine _
& "Please see attached an announcement of the spot buy promotion for week " & Range("I8").value & ", " & Range("T8").value & "." & vbNewLine & vbNewLine _
& "Please can you confirm within 24 hours." & vbNewLine)
End If
'Embed Excel Sheet Range
Set Data = New DataObject
Data.GetFromClipboard
Call Body.ADDNEWLINE(2)
Call Body.EmbedObject(1454, "", Range("F" & i).value, "Attachment")
'create an signature
Call Body.ADDNEWLINE(4)
Call Body.APPENDTEXT("Kind regards / Mit freundlichen Grüßen," & vbNewLine & vbNewLine _
& "The Food Specials Team" & vbNewLine & vbNewLine)
Dim rng As Range
Set rng = ThisWorkbook.Worksheets(1).Range("G17:AD17").SpecialCells(xlCellTypeVisible)
'create an signature
Call Body.ADDNEWLINE(3)
Call Body.APPENDTEXT(rangetoHTML(rng))
'Example to save the message (optional) in Sent items
MailDoc.SaveMessageOnSend = True
'Send the document
'Gets the mail to appear in the Sent items folder
Call MailDoc.ReplaceItemValue("PostedDate", Now())
Call MailDoc.Send(False)
Set MailDoc = Nothing
j = j + 1
Next i
End With
'Clean Up the Object variables - Recover memory
Set Maildb = Nothing
Set Body = Nothing
Set Session = Nothing
Application.CutCopyMode = False
MsgBox "Success!" & vbNewLine & "Announcements have been sent."
End If
End Sub
Function rangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
filename:=TempFile, _
Sheet:=TempWB.Sheets(1).name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
rangetoHTML = ts.ReadAll
ts.Close
rangetoHTML = Replace(rangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
我怀疑范围不会正确复制/粘贴，因为我的电子邮件似乎是用纯文本写的。但我不知道如何将其转换为HTML。
请有人告诉我我哪里出错了，以及我如何根据需要复制/粘贴我的范围。
由于