修改Outlook邮件超链接以移除路径中的文件名

刚好能帮你搞定这个需求！你需要修改已打开Outlook邮件里的超链接，把路径最后一个反斜杠后的文件名去掉，这样点击链接就能直接打开SharePoint映射的网络共享文件夹（文件所在位置）。下面是具体的实现思路和完整代码：

核心思路 #

要实现这个效果，关键是对每个超链接的地址做两步处理：

• 定位到地址中最后一个反斜杠的位置
• 截取该位置之前的所有内容，作为新的超链接地址（也就是文件夹路径）

完整VBA代码 #

Sub HyperLinkChange()
    Dim objDoc As Object
    Dim objHyperlink As Object
    Dim strOriginalLink As String
    Dim intLastBackslash As Integer
    Dim strNewLink As String
    
    ' 获取当前打开邮件的Word编辑对象（Outlook邮件编辑基于Word引擎）
    Set objDoc = Application.ActiveInspector.WordEditor
    
    ' 遍历邮件中所有超链接
    For Each objHyperlink In objDoc.Hyperlinks
        strOriginalLink = objHyperlink.Address
        
        ' 从字符串末尾开始查找最后一个反斜杠的位置
        intLastBackslash = InStrRev(strOriginalLink, "\")
        
        ' 过滤掉根路径（比如C:\），只处理包含子文件夹的路径
        If intLastBackslash > 2 Then
            ' 截取最后一个反斜杠之前的内容，得到文件夹路径
            strNewLink = Left(strOriginalLink, intLastBackslash - 1)
            ' 更新超链接的地址
            objHyperlink.Address = strNewLink
            
            ' 可选：如果需要把超链接的显示文本也改成文件夹路径，取消下面的注释
            ' objHyperlink.TextToDisplay = strNewLink
        End If
    Next objHyperlink
    
    MsgBox "超链接修改完成！", vbInformation
End Sub

代码关键说明 #

• Application.ActiveInspector.WordEditor：这行代码用来获取当前打开邮件的编辑对象，因为Outlook的邮件编辑界面是基于Word的，所以我们可以用Word的对象模型来操作超链接
• InStrRev：和普通的InStr不同，这个函数是从字符串的末尾开始查找指定字符，能精准定位最后一个反斜杠的位置，这是实现需求的核心
• 加入intLastBackslash > 2的判断：避免处理类似C:\这样的根路径，防止出现无效的空路径

使用步骤 #

1. 打开Outlook，打开你需要修改超链接的邮件
2. 按下Alt + F11打开VBA编辑器
3. 在左侧的Project窗格中，右键点击Outlook对象，选择Insert -> Module
4. 将上面的代码粘贴到新建的模块中
5. 按下F5运行宏，或者回到Outlook，通过「开发工具」选项卡的「宏」按钮运行这个宏

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