如何在VBA中导入本地HTML文件内容并通过Outlook发送HTML格式邮件?
2026-3-31
如何在VBA中导入本地HTML文件内容并通过Outlook发送HTML格式邮件?
#
我明白你的问题啦——你现在直接把HTML文件路径赋值给
.HTMLBody
,Outlook当然只会把它当纯文本显示,而不会去读取文件里的HTML内容。咱们得先把本地HTML文件的代码读成字符串,再放到邮件的HTMLBody里,还要结合你原来的签名逻辑,我给你一步步改代码:
第一步:先写一个读取HTML文件的工具函数 #
咱们用
Scripting.FileSystemObject
来读取本地HTML文件的全部内容,这个方法兼容性好,不用额外引用库:
Function ReadHTMLFile(filePath As String) As String Dim fso As Object Dim textStream As Object Dim fullHTML As String ' 初始化文件系统对象 Set fso = CreateObject("Scripting.FileSystemObject") ' 打开HTML文件(1代表只读模式) Set textStream = fso.OpenTextFile(filePath, 1) ' 读取文件全部内容 fullHTML = textStream.ReadAll ' 关闭文件 textStream.Close ' 返回读取到的HTML内容 ReadHTMLFile = fullHTML End Function
第二步:修改你的主代码(解决核心问题+修复小bug) #
我帮你统一了变量名、补全了Late Binding下的Outlook常量(因为你用
CreateObject
而不是引用Outlook库,VBA不知道
olFormatHTML
这些内置常量),关键是替换了直接赋值路径的错误逻辑:
' 先定义Outlook常量(Late Binding下必须手动定义,不然会报错)
Const olMinimized As Integer = 1
Const olFormatHTML As Integer = 2
Const olMailItem As Integer = 0
Sub SendJobReceivedEmail()
Dim WatchRange As Range
Dim r As Double
Dim Low As Long, High As Long
Dim OutApp As Object
Dim OutMail As Object
Dim signature As String
Dim htmlFilePath As String
' 定义要监控的单元格范围
Set WatchRange = ThisWorkbook.ActiveSheet.Range("I3:I100")
' 检查是否在监控范围内触发了修改,且值为"Pending"
If Not Intersect(Target, WatchRange) Is Nothing Then
If Intersect(Target, WatchRange).Value = "Pending" Then
' 生成随机AES编号
Low = 1
High = 999999
r = Int((High - Low + 1) * Rnd() + Low)
ThisWorkbook.ActiveSheet.Cells(ActiveCell.Row, "C").Value = "AES" & r
' 初始化Outlook对象
Set OutApp = CreateObject("Outlook.Application")
With OutApp
.ActiveWindow.WindowState = olMinimized ' 最小化Outlook窗口
.Session.Logon ' 登录Outlook会话
End With
' 创建新邮件
Set OutMail = OutApp.CreateItem(olMailItem)
' 先显示邮件获取默认签名
On Error Resume Next
With OutMail
.BodyFormat = olFormatHTML
.Display ' 必须先Display才能获取签名
End With
On Error GoTo 0 ' 恢复错误捕获
signature = OutMail.HTMLBody ' 保存默认HTML签名
' 开始配置邮件内容
With OutMail
.To = ThisWorkbook.ActiveSheet.Cells(ActiveCell.Row, "G").Value
.CC = ""
.BCC = "[email protected]"
.Subject = "Your Quote - ID: " & ThisWorkbook.ActiveSheet.Cells(ActiveCell.Row, "C").Value
.BodyFormat = olFormatHTML
' 读取本地HTML文件内容,拼接签名
htmlFilePath = "C:\Users\sales1\OneDrive - All Emergency Services Company\Documents\Mark O'Brien - Accounts Onboarding Tracker\ChkT - Email Template\Review\index.html"
If Time < TimeValue("12:00:00") Then
.HTMLBody = ReadHTMLFile(htmlFilePath) & signature
End If
' 测试阶段可以把.Send改成.Display,先预览邮件再发送
' .Display
.Send
.ReadReceiptRequested = False
End With
' 释放Outlook对象(避免内存泄漏)
Set OutMail = Nothing
Set OutApp = Nothing
End If