Question

我正在使用此代码通过vba发送电子邮件，但我需要发送一个表作为正文。此代码仅发送一个单元格而不是范围。

如何将范围（“B5：D10”）粘贴为邮件正文中的表格？

Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
    .To = Range("B1").Value
    .Cc = Range("B2").Value
    .Bcc = Range("B3").Value
    .Subject = Range("B4").Value
    .Body = Range("B5").Value
    .Send
End With
On Error GoTo 0
Set OutMail = Nothing

谢谢

Answer 1

您可以通过设置HTMLBody而不是Body来实现这一目标。但是，要控制消息的格式化，您必须具有HTML的基本知识。

它背后的想法如下：你必须将范围内容与HTML标签放在一起：

Dim rng As Range, cell As Range, HtmlContent As String, i As Long, j As Long
Set rng = Range("B5:D10")
HtmlContent = "<table>"

For i = 5 To rng.Rows.Count + 4
    HtmlContent = HtmlContent & "<tr>"
    For j = 2 To rng.Columns.Count + 2
        HtmlContent = HtmlContent & "<td>" & Cells(i, j).Value & "</td>"
    Next
    HtmlContent = HtmlContent & "</tr>"
Next
HtmlContent = HtmlContent & "</table>"

然后，将此表放在一条消息中：

With OutMail
    '...
    .HTMLBody = HtmlContent
    '...
End With

Answer 2

你做不到。 Thant身体论证只接受弦乐。还有另一个问题：格式化。

如果我记得很清楚我在你的情况下使用like this来生成范围内的html文件。

然后我使用TStream获取“.html”文件并将结果放入正文中。包装所有这些是伪的：

Public Sub Email()

Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
Dim FSObj As Scripting.FileSystemObject
Dim TStream As Scripting.TextStream
Dim rngeSend As Range
Dim strHTMLBody As String


'Select the range to be sent
Set rngeSend = Application.Range("B1:G35")
If rngeSend Is Nothing Then Exit Sub    'User pressed Cancel
On Error GoTo 0

'Now create the HTML file
ActiveWorkbook.PublishObjects.Add(xlSourceRange, "C:\sales\tempsht.htm", rngeSend.Parent.Name, rngeSend.Address, xlHtmlStatic).Publish True


'Create an instance of Outlook (or use existing instance if it already exists
Set olApp = CreateObject("Outlook.Application")

'Create a mail item
Set olMail = olApp.CreateItem(olMailItem)

'Open the HTML file using the FilesystemObject into a TextStream object
Set FSObj = New Scripting.FileSystemObject
Set TStream = FSObj.OpenTextFile("C:\sales\tempsht.htm", ForReading)

'Now set the HTMLBody property of the message to the text contained in the TextStream object
strHTMLBody = TStream.ReadAll

olMail.HTMLBody = strHTMLBody
olMail.To = "anybody@anywhere.com"
olMail.Subject = "Email Subject"
olMail.Send

希望它有所帮助！

Answer 3

你可以这样试试。

Sub test()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set rng = Selection.SpecialCells(xlCellTypeVisible)
Set rng = Sheets("Sheet1").Range("B5:D10").SpecialCells(xlCellTypeVisible)
On Error Resume Next
With OutMail
    .To = Range("B1").Value
    .Cc = Range("B2").Value
    .Bcc = Range("B3").Value
    .Subject = Range("B4").Value
    .HTMLBody = RangetoHTML(rng)
    .Display
End With
On Error GoTo 0
Set OutMail = Nothing
End Sub
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"
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
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

Answer 4

saransh 的回答似乎基于 Ron de Bruin 的 this solution。但是，它有一个缺陷，即文本被其他单元格隐藏的单元格会导致该文本在结果中被截断。

这是因为 html 以 display:none 样式呈现此文本。一个简单的解决方案是在读取 html 文件时添加一行。在这一行之后：

RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                      "align=left x:publishsource=")

添加：

RangetoHTML = Replace(RangetoHTML, "display:none", "")

这将导致显示隐藏的文本并且表格会自动调整列的大小。

在MailBody中发送Excel表

4 个答案: