Copy-Paste nu merge in email body.
Trebuie sa formatezi continutul in format html, un exemply de email body:
Cod: Selectaţi tot
Sig = OutMail.HTMLbody 'get the signature, we will insert it later, at the end of the new body message
.Subject = "Receipt for Payment"
.HTMLbody = "<IMG src='Logo.png'><br />" & RangetoHTML(Rng) _
& "<br /><a href=" & Range("Policy").Offset(0, 5) & ">" & Range("Policy") & "</a><br />" _
& "<br /><a href=" & Range("TermDates").Offset(0, 5) & ">" & Range("TermDates") & "</a><br />" _
& "<br /><a href=" & Range("Parking").Offset(0, 5) & ">" & Range("Parking") & "</a><br /><br /><br />" _
& "<IMG src='Logo.png' width=120 height=80>" & "<br /><br />" & _
"<b><font size=""4"">" & Range("Sapphire") & "</font></b><br />" & _
"<a href=" & Range("WebSite").Offset(0, 5) & ">" & Range("WebSite") & "</a><br />" & _
"<a href=" & Replace(Range("Phone").Offset(0, 5), " ", "%20") & ">" & Range("Phone") & "</a><br />" & _
"<a href=" & Range("_Mailto").Offset(0, 5) & ">" & Range("_Mailto") & "</a><br />" & Sig
Functia RangetoHTML preia un range din excel si il transforma in html, acceptat de outlook, o gasesti si pe net:
Cod: Selectaţi tot
Function RangetoHTML(Rng As Range)
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 paste 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).PasteSpecial xlPasteColumnWidths, , 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
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=")
TempWB.Close savechanges:=False
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
O alta varianta este sa folosesti editorul de text utilizat de outlook, in care poti sa executi copy paste:
Cod: Selectaţi tot
Dim wordDoc As Word.Document
Set wordDoc = outMail.GetInspector.WordEditor
wordDoc.Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
Daca e nevoie de adaugat si alte texte, trebuie utilizat cod specific Word pentru adaugare paragrafe suplimentare.
Probleme să fie, că soluţii se găsesc...