VBA如何将HTML放入通过Access模块​​发送的电子邮件中

我有一些VBA代码给我,通过MS Access发送附件的电子邮件:

Sub Email_Send() Dim strTo As String Dim strCc As String Dim strFrom As String Dim strSubject As String Dim strMessage As String Dim intNrAttch As Integer Dim strAttachments As String Dim strAttachments2 As String Dim Contact_Name As String Dim EMAIL_Address As String Dim CC_Address As String Dim Column1 As ADODB.Recordset Dim cnnDB As ADODB.Connection Dim Area As String Dim Connection As String Dim BasePath As String Dim Region As String Dim Column2 As String Dim UPC As String Dim Name As String Dim FirstName As String Dim Title As String Dim Surname As String Dim Bold As String Dim a As String BasePath = "MY PATH" Set cnnDB = New ADODB.Connection With cnnDB .Provider = "Microsoft.Jet.OLEDB.4.0" .ConnectionString = "MY CONNECTION STRING" .Open End With Set rstRst = New ADODB.Recordset rstRst .Source = "SELECT [column1], [column2], [column3]" & _ "FROM table1" rstRst.Open , cnnDB rstRst.MoveFirst Do While Not rstRst .EOF Column1 = rstRst.Fields("Column1") Column2 = rstRst.Fields("Column2") Column3_Address = rstRst.Fields("Column3") Dim Greeting As String If Time >= #12:00:00 PM# Then Greeting = "Afternoon," Else Greeting = "Morning," End If Dim CurrentMonth As String CurrentMonth = MonthName(Month(Date)) strMessage = "Good" & Greeting & Chr(13) strMessage = strMessage & Chr(13) strMessage = strMessage & "...TEXT..." & Chr(13) strMessage = strMessage & Chr(13) strMessage = strMessage & "...TEXT..." & Chr(13) strMessage = strMessage & "" & Chr(13) strMessage = strMessage & "...TEXT..." & Chr(13) strMessage = strMessage & "" & Chr(13) strMessage = strMessage & "...TEXT..." & Chr(13) strMessage = strMessage & "" & Chr(13) strMessage = strMessage & "...TEXT..." & Chr(13) strMessage = strMessage & "...TEXT..." & Chr(13) strMessage = strMessage & Chr(13) strMessage = strMessage & "...TEXT..." & Chr(13) strMessage = strMessage & "...TEXT..." & Chr(13) strTo = EMAIL_Address 'strCc = CC_Address strSubject = "Information: ...TEXT..." & Column2 & "...TEXT..." intNrAttch = 1 strAttachments = BasePath & Column1 & "file.xls" Call SendMessageTo(strTo, strSubject, strMessage, intNrAttch, strAttachments) rstRST.MoveNext Loop MsgBox "sent" NowExit: End Sub Public Function SendMessageTo(strTo As String, strSubject As String, strMessage As String, intNrAttch As Integer, strAttachments As String) As Boolean Const Nr = 9 Dim MyOutlook As Object Dim MyMessage As Object Dim objNameSpace Dim strFiles(Nr) As String Dim strPromt As String Dim i As Integer, intLen As Integer Dim intStart, intPos As Integer On Error GoTo Error_Handler SendMessageTo = False Set MyOutlook = CreateObject("Outlook.Application") Set MyMessage = MyOutlook.CreateItem(0) If strTo = "" Then strPromt = "You need to specify the e-mail address to wich you want to send this e-mail" MsgBox strPromt, vbInformation, "Send Message To... ?" Exit Function End If If intNrAttch > Nr + 1 Then strPromt = "You can only add up to " & Nr + 1 & " attachments. If you want to add more you will need to change the array size" MsgBox strPromt, vbCritical, "Number of Attachments" End If intStart = 1 intLen = 0 If strAttachments <> "" Then For i = 0 To intNrAttch - 1 If i < intNrAttch - 1 Then intLen = InStr(intStart, strAttachments, ";") - intStart + 1 strFiles(i) = Trim(Mid(strAttachments, intStart, intLen - 1)) intStart = intStart + intLen Else strFiles(i) = Trim(Mid(strAttachments, intStart, Len(strAttachments) - intStart + 1)) End If Next i End If intPos = Len(strMessage) + 1 With MyMessage .To = strTo .Subject = strSubject .Body = strMessage strAttachments = "1" If strAttachments <> "" Then For i = 0 To intNrAttch - 1 .Attachments.Add strFiles(i), 1, intPos Next i End If .Send End With Set MyMessage = Nothing Set MyOutlook = Nothing SendMessageTo = True Error_Handler_Exit: Exit Function Error_Handler: MsgBox Err.Number & " : " & Err.Description, vbCritical, Error Resume Error_Handler_Exit End Function 

我想要做的就是使用HTML来格式化strMessage = "...TEXT..." ,例如将其加粗。

我尝试了以下操作:

 Set MyMessage = MyOutlook.CreateItem(0) With MyMessage .HTMLBody = .HTMLBody & "<br><B>WEEKLY REPPORT:</B><br>" _ & "<img src='cid:DashboardFile.jpg'" & "width='814' height='33'><br>" _ & "<br>Best Regards,<br>Ed</font></span>" End With 

我看了各种网站,包括: http : //vba-useful.blogspot.co.uk/2014/01/send-html-email-with-embedded-images.html但我不能得到它的工作。

我怎样才能做到这一点?

首先,不要混合使用.Body和.HTMLBody。 选一个。 正如你想格式化和图片,.HTMLBody是你所需要的。

其次:不要混合使用大写和小写HTML标签。 使用较低。

第三:注意无效的HTML,如closures一个从未打开过的字体和span标签。 也使用<br />而不是<br> (过时)。

第四:完全设置HTMLBody,不要附加到它。

我不知道你的img是否会显示,但是这是第二步。 这就是说,试试这个:

 MyMessage.HTMLBody = "<p class=MsoNormal>" & strMessage & "<br /><b>WEEKLY REPORT:</b><br />" _ & "<img src='cid:DashboardFile.jpg' width='814' height='33' /><br />" _ & "<br />Best Regards,<br />Ed</p>" 

编辑:如果你想保持strMessage中的换行符,只需用<br />replacechr(13)