如何将Excel工作表另存为HTML并保留图片的网络源而非本地源

A. 能否导出HTML时保留图片的网络源？ #

Excel原生的PublishObjects.Publish或SaveAs xlHtml方法无法直接保留图片的网络源。这是因为Excel默认会自动下载网络图片到与HTML文件关联的_files文件夹中，并将HTML里的图片src替换为本地相对路径，这是导出HTML的内置行为，没有直接的参数可以修改。

B. 修改生成的HTML替换图片源的方案 #

可以通过「先收集原图片网络URL → 导出HTML → 替换HTML中的图片路径」的流程解决，以下是针对两种导出方法的具体实现：

前提：收集工作表中图片的原网络URL #

先通过VBA遍历工作表，记录所有网络图片的原URL（假设图片是通过网络URL加载的，可通过LinkFormat.SourceFullName获取）：

Dim pic As Picture
Dim imgUrls As Collection
Set imgUrls = New Collection

' 遍历工作表中的所有网络图片，记录原URL
For Each pic In wbTemp.Sheets(1).Pictures
    If pic.LinkFormat.Type = xlLinkTypePicture Then
        imgUrls.Add pic.LinkFormat.SourceFullName
    End If
Next pic

针对方法1（PublishObjects）的修改步骤 #

1. 执行原代码导出HTML
2. 读取HTML文件内容，将本地图片路径替换为原网络URL
3. 保存修改后的HTML，再加载到Outlook邮件

' 1. 导出HTML（原代码）
With wbTemp.PublishObjects.Add( _
     SourceType:=xlSourceRange, _
     Filename:=htmlFilePath, _
     Sheet:=wbTemp.Sheets(1).Name, _
     Source:=wbTemp.Sheets(1).UsedRange.Address, _
     HtmlType:=xlHtmlStatic)
     .Publish (True)
End With

' 2. 读取并修改HTML内容
Dim htmlContent As String
Dim fso As Object, ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")

' 读取原HTML
Set ts = fso.OpenTextFile(htmlFilePath, 1, False, -2) ' -2表示Unicode编码
htmlContent = ts.ReadAll
ts.Close

' 替换图片src：按顺序匹配收集的URL，替换本地路径
Dim i As Integer
For i = 1 To imgUrls.Count
    Dim oldSrc As String, newSrc As String
    ' 构造Excel生成的本地图片路径
    oldSrc = "src=""" & Left(htmlFilePath, InStrRev(htmlFilePath, "\")) & _
             Mid(htmlFilePath, InStrRev(htmlFilePath, "\") + 1, Len(htmlFilePath) - InStrRev(htmlFilePath, "\") - 4) & _
             "_files/image" & Format(i, "000") & ".jpg"""
    ' 替换为原网络URL
    newSrc = "src=""" & imgUrls(i) & """"
    htmlContent = Replace(htmlContent, oldSrc, newSrc)
Next i

' 保存修改后的HTML
Set ts = fso.CreateTextFile(htmlFilePath, True, -2)
ts.Write htmlContent
ts.Close

' 3. 加载到Outlook邮件
Dim olApp As Object, olMail As Object
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(0)
olMail.HTMLBody = htmlContent
olMail.Display

针对方法2（SaveAs xlHtml）的修改步骤 #

这种方法生成的是带框架的HTML，Outlook不支持框架，因此需要直接读取内容页（而非主框架页）并修改：

1. 执行原代码另存为HTML
2. 找到关联文件夹中的内容页（如xxx_files/sheet001.htm）
3. 替换内容页中的图片路径，再加载到Outlook邮件

' 1. 另存为HTML（原代码）
wbTemp.SaveAs Filename:=htmlFilePath, FileFormat:=xlHtml

' 2. 定位到内容页路径
Dim contentHtmlPath As String
contentHtmlPath = Left(htmlFilePath, InStrRev(htmlFilePath, "\")) & _
                  Mid(htmlFilePath, InStrRev(htmlFilePath, "\") + 1, Len(htmlFilePath) - InStrRev(htmlFilePath, "\") - 4) & _
                  "_files/sheet001.htm"

' 读取并修改内容页HTML
Dim htmlContent As String
Dim fso As Object, ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")

Set ts = fso.OpenTextFile(contentHtmlPath, 1, False, -2)
htmlContent = ts.ReadAll
ts.Close

' 替换图片src
Dim i As Integer
For i = 1 To imgUrls.Count
    Dim oldSrc As String, newSrc As String
    oldSrc = "src=""image" & Format(i, "000") & ".jpg"""
    newSrc = "src=""" & imgUrls(i) & """"
    htmlContent = Replace(htmlContent, oldSrc, newSrc)
Next i

' 3. 加载到Outlook邮件
Dim olApp As Object, olMail As Object
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(0)
olMail.HTMLBody = htmlContent
olMail.Display

补充说明 #

• 手动复制粘贴正常是因为浏览器可访问本地图片文件，而Outlook程序化加载时受安全限制无法读取本地路径，替换为网络URL后即可正常加载。
• 若图片不是通过LinkFormat关联的网络URL，可提前给图片设置AlternativeText存储原URL，遍历读取时改用pic.AlternativeText即可。

内容的提问来源于stack exchange，提问作者DDV