如何提取Excel单元格中超链接的完整绝对路径？

问题根源 #

原有单元格的超链接本身存储的就是相对路径，修改工作簿的Hyperlink Base属性仅对新创建的超链接生效，不会自动转换已存在的相对路径。

方法1：提取绝对路径（不修改原超链接） #

通过VBA结合文件系统对象，自动解析相对路径为绝对路径，避免手动拼接出错：

Sub GetAbsoluteHyperlinkPath()
    Dim ws As Worksheet
    Dim cell As Range
    Dim fso As Object
    Dim relativePath As String
    Dim absolutePath As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ws = ThisWorkbook.Worksheets("Sheet1") '替换为你的工作表名称
    
    '遍历A列所有带超链接的单元格，可按需修改范围
    For Each cell In ws.Range("A:A").SpecialCells(xlCellTypeConstants, xlCellTypeHyperlinks)
        If cell.Hyperlinks.Count > 0 Then
            relativePath = cell.Hyperlinks(1).Address
            '结合工作簿路径转换为绝对路径，自动处理../这类上级目录符号
            absolutePath = fso.GetAbsolutePathName(ThisWorkbook.Path & "\" & relativePath)
            '将结果写入C列（当前单元格右侧第2列），可修改目标列
            cell.Offset(0, 2).Value = absolutePath
        End If
    Next cell
    
    Set fso = Nothing
    Set ws = Nothing
    MsgBox "绝对路径提取完成！"
End Sub

关键说明：

• Scripting.FileSystemObject：专门处理文件路径的组件，能正确解析../、./这类相对路径标识
• ThisWorkbook.Path：获取当前工作簿所在的文件夹路径（必须先保存工作簿，否则此值为空）
• SpecialCells：精准定位带超链接的单元格，提升运行效率

方法2：批量转换现有超链接为绝对路径 #

如果需要直接修改原单元格的超链接，把相对路径替换成绝对路径，用这段代码：

Sub ConvertRelativeHyperlinksToAbsolute()
    Dim ws As Worksheet
    Dim cell As Range
    Dim fso As Object
    Dim relativePath As String
    Dim absolutePath As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ws = ThisWorkbook.Worksheets("Sheet1") '替换为你的工作表名称
    
    '检查工作簿是否已保存
    If ThisWorkbook.Path = "" Then
        MsgBox "请先保存工作簿，再执行此代码！"
        Exit Sub
    End If
    
    For Each cell In ws.Range("A:A").SpecialCells(xlCellTypeConstants, xlCellTypeHyperlinks)
        If cell.Hyperlinks.Count > 0 Then
            relativePath = cell.Hyperlinks(1).Address
            absolutePath = fso.GetAbsolutePathName(ThisWorkbook.Path & "\" & relativePath)
            '替换原超链接地址为绝对路径
            cell.Hyperlinks(1).Address = absolutePath
        End If
    Next cell
    
    Set fso = Nothing
    Set ws = Nothing
    MsgBox "超链接已批量转换为绝对路径！"
End Sub

注意事项：

• 执行前请备份工作簿，避免误操作
• 可根据实际需求修改代码中的工作表名称和目标单元格范围

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