问题
I wanted to insert a table of data from Sheet1 of my excel workbook and after inserting the same i need to insert my signature. I tried using HTMLBody. But it displays the signature either before the table is displayed or nothing at all. I tried changing the positions of the .HTMLBody but to no avail. In short have to to send a mail of the below format:
- To:
- CC:
- BCC:
- Subject:
- Body: should contain"Hi Please find below the details"
- Then the excel table with the data of range ("A3:F3)
- Then my signature (which is the default signature in outlook or something which could be created)
- and SEND.
The below is the code which i currently have. Can anyone pleaaaassseeeeee HELP MEEEEEE !!!!
Sub esendtable()
Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object
Set outlook = CreateObject("Outlook.Application")
Set newEmail = outlook.CreateItem(0)
With newEmail
.To = "avc@123.com"
.CC = ""
.BCC = ""
.Subject = "Data - " & Date
.Body = "Please find below the data"
.Display
Set xInspect = newEmail.GetInspector
Set pageEditor = xInspect.WordEditor
Sheet1.Range("B3:F3").Copy
pageEditor.Application.Selection.Start = Len(.Body)
pageEditor.Application.Selection.End =
pageEditor.Application.Selection.Start
pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)
.Display
'.Send
Set pageEditor = Nothing
Set xInspect = Nothing
End With
Set newEmail = Nothing
Set outlook = Nothing
End Sub
回答1:
This works for me
Sub esendtable()
Dim rng As Range
Dim Outlook As Object
Dim newEmail As Object
Dim SigString As String
Dim Signature As String
Dim xInspect As Object
Dim pageEditor As Object
Set rng = Nothing
On Error Resume Next
' Only send the visible cells in the selection.
Set rng = ActiveSheet.Range("A3:F3")
' You can also use a range with the following statement.
Set rng = Sheets("YourSheet").Range("A3:F3").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected. " & _
vbNewLine & "Please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set Outlook = CreateObject("Outlook.Application")
Set newEmail = Outlook.CreateItem(0)
SigString = "C:\Users\chipz\AppData\Roaming\Microsoft\Signatures\chipz_1.htm" ' Change chipz in path and signature file name
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
On Error Resume Next
With newEmail
.To = "recipient@test.com"
.CC = ""
.BCC = ""
.Subject = "Data - " & Date
.BodyFormat = olFormatHTML
.HTMLBody = RangetoHTML(rng) & "" & Signature
.Display
' In place of the following statement, you can use ".Display" to
' display the e-mail message.
'.Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set newEmail = Nothing
Set Outlook = Nothing
Set newEmail = Nothing
Set Outlook = Nothing
End Sub
Function RangetoHTML(rng As Range)
' Ron de Bruin
'
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
Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
回答2:
You can handle your email's body by
Outlook.CreateItem(olMailItem).GetInspector.WordEditor.Range
So following simple code snippet
- preserves the standard signature for a new email
- pastes the Excel range as range, picture or plain text
- adds text before Excel range and/or between it and signature
With pageEditor.Range
.Collapse 1 ' wdCollapseStart
.InsertBefore "Hi Please find below the details" & vbCrLf
.Collapse 0 ' wdCollapseEnd
.InsertAfter "Text before signature" & vbCrLf
.Collapse 1 ' wdCollapseStart
Sheet1.Range("B3:F3").Copy
.Paste
'.PasteAndFormat 13 ' wdChartPicture
'.PasteAndFormat 22 ' wdFormatPlainText
End With
If you add a reference to "Microsoft Word x.x Object Library" (and "Microsoft Outlook x.x Object Library") for early binding, you can replace the numbers by the corresponding Word ENUM constants.
来源:https://stackoverflow.com/questions/54966814/i-want-to-insert-my-default-signature-after-inserting-a-table-of-data-from-an-ex