如何在Outlook发送邮件中填充已保存工作表的超链接地址

现有一段Excel VBA代码，可实现保存活动文档副本并发送带有该文档附件的Outlook邮件。当前邮件中的超链接为硬编码的通用文件夹地址，需替换为以下两种自定义方案之一：

方案1：直接打开已保存文件的超链接（优先） #

将邮件中的超链接改为指向用户实际保存的文件路径，点击后直接打开该文件（非附件）。修改时需替换邮件HTML正文里的超链接部分，使用实际保存的文件路径变量fileSaveName（注：原示例中写的MyFileDest是文件夹路径，若要打开文件需用包含文件名的fileSaveName，以下代码已修正此逻辑）。

修改后的完整代码 #

'Establish file name and save location using data from Form
    Dim MyFile, MyFileDest, MyFileName As String
    
    MyFile = ActiveSheet.Range("B5").Value & " " & ActiveSheet.Range("F5").Value & " " & ActiveSheet.Range("E5").Value & " (" & ActiveSheet.Range("AB8").Value & ")" & ".xlsm"
    MyFileDest = "\\camawsis03\Team Center\" & ActiveSheet.Range("B5").Value & "\" & ActiveSheet.Range("B5").Value & " " & "Rework Forms\\"
    MyFileName = MyFileDest & MyFile
    
'Check if folder exist, if not create folder
    If Dir(MyFileDest, vbDirectory) <> vbNullString Then
    'MsgBox "Folder exists"
    Else
        MkDir "\\camawsis03\Team Center\" & ActiveSheet.Range("B5").Value & "\" & ActiveSheet.Range("B5").Value & " " & "Rework Forms"
    End If

'Save to location and include pop-up Save As window
    Dim NewName As Variant
    Dim fileSaveName As Variant
    
    NewName = MyFileName
    fileSaveName = Application.GetSaveAsFilename(InitialFileName:=NewName, fileFilter:="Excel Files (*.xlsm), *.xlsm")

    If fileSaveName <> False Then
        ActiveWorkbook.SaveAs fileSaveName
        'MsgBox "File saved to: " & fileSaveName
    End If

'Email with attached workbook.
    Set OutlookApp = CreateObject("Outlook.Application")
    Set SendMail = OutlookApp.CreateItem(0)
    Dim JobDesc As String
    Dim Rootcause As String
    JobDesc = ActiveSheet.Range("B5").Value & " " & ActiveSheet.Range("F5").Value & " " & ActiveSheet.Range("E5").Value
    Rootcause = ActiveSheet.Range("N5").Value & " - " & ActiveSheet.Range("N6").Value & " - " & ActiveSheet.Range("N7").Value
    
    SourceFile = ThisWorkbook.FullName
    SendMail.Attachments.Add SourceFile

    SendMail.Subject = ActiveSheet.Range("B5").Value & " " & ActiveSheet.Range("F5").Value & " " & ActiveSheet.Range("E5").Value & " " & "Rework" & " " & "(" & ActiveSheet.Range("AB8").Value & ")"
    SendMail.To = Leaderemail & ";" & ActiveSheet.Range("AC5").Value
    SendMail.CC = ActiveSheet.Range("AC6").Value & "; mcatalano@windsormoldgroup.com"
    'Use SendMail.htmlBody for bold,unbold <b>,</b>= & new line=<br>
    SendMail.htmlBody = "Please find attached Rework Form for " & JobDesc & "." & " " & "Steel is located in" & " " & ActiveSheet.Range("E7").Value & "." & "<br><br>" _
    & WorkReqdComment & "<br><br>" _
    & PrepReqdComment & "<br><br>" _
    & "The attached is for notification only. Please reference master saved <a href=""file:///" & Replace(fileSaveName, "\", "/") & """>here.</a>"
    
    SendMail.Display 'displays email window
    'Use SendMail.Send to send without display.
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    
    Set SendMail = Nothing
    Set OutlookApp = Nothing
    
    ActiveWorkbook.Close savechanges:=False
End Sub

说明：

• 将超链接路径转换为file:///协议格式，替换反斜杠为正斜杠，确保Outlook能正确识别链接。
• 移除了冗余的vbCrLf（HTML正文里<br>已足够换行，vbCrLf会生成多余空白）。
• 修正了CC地址末尾多余的>符号。

方案2：打开已保存文件所在文件夹的超链接 #

若需指向文件所在文件夹，将超链接替换为文件夹路径即可。推荐从实际保存路径中提取父文件夹（适配用户修改保存路径的情况），或直接使用初始定义的MyFileDest（仅当用户未修改保存路径时有效）。

修改后的邮件正文关键部分 #

方式A：从实际保存路径提取文件夹（推荐）

Dim folderPath As String
folderPath = Left(fileSaveName, InStrRev(fileSaveName, "\"))

SendMail.htmlBody = "Please find attached Rework Form for " & JobDesc & "." & " " & "Steel is located in" & " " & ActiveSheet.Range("E7").Value & "." & "<br><br>" _
& WorkReqdComment & "<br><br>" _
& PrepReqdComment & "<br><br>" _
& "The attached is for notification only. Please reference master saved <a href=""file:///" & Replace(folderPath, "\", "/") & """>here.</a>"

方式B：使用初始定义的文件夹路径

SendMail.htmlBody = "Please find attached Rework Form for " & JobDesc & "." & " " & "Steel is located in" & " " & ActiveSheet.Range("E7").Value & "." & "<br><br>" _
& WorkReqdComment & "<br><br>" _
& PrepReqdComment & "<br><br>" _
& "The attached is for notification only. Please reference master saved <a href=""file:///" & Replace(MyFileDest, "\", "/") & """>here.</a>"

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