如何使用Visual Basic从Excel添加一系列单元格作为自定义SMTP电子邮件的正文

Question

单击Excel中的一个按钮，我将在工作表上发送一系列单元格作为电子邮件的正文。电子邮件发送正确，但我不知道如何将实际范围的单元格添加为正文。以下是我目前在Excel的Visual Basic中使用的代码，以及Micrsoft CDO for Windows 2000 Library:

Sub Email_Figures_Click()
Dim myMail As CDO.Message
Set myMail = New CDO.Message
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "HIDDEN"
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "HIDDEN"
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "HIDDEN"
myMail.Configuration.Fields.Update
With myMail
.Subject = "HIDDEN"
.From = "HIDDEN"
.To = "HIDDEN"
Dim myRng As Range
Set myRng = Nothing
'Only the visible cells in the selection
Set myRng = Sheets("Monthly Figures").Range("A1:B29").SpecialCells(xlCellTypeVisible)
If myRng 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
.HTMLBody = myRng
End With
On Error Resume Next
myMail.Send
MsgBox ("Email has been sent!")
Set myMail = Nothing
End Sub

任何带有HIDDEN字样的东西都是为了保护客户。

感谢您的帮助。

Answer 1

如果我理解正确，您不能简单地将范围分配给.HTMLBody。您可能需要"手动"构建HTML字符串，并具有类似的内容

html_text = "<table>" & vbCrLf & "<tr>"
For Each Row In myrng.Rows
For Each cell In Row.Cells
html_text = html_text & "<td>" & cell.Text & "</td>"
Next cell
html_text = html_text & "</tr>" & vbCrLf
Next Row
html_text = html_text & "</table>"
.HTMLBody=html_text

更换线路

.HTMLBody = myRng