VBA: 獲取單元格內超連結文件的絕對路徑

收錄於話題 #VBA編程基礎 8個

        文章背景：在工作中，有時為了內容跳轉的方便，會在單元格內設置超連結，通過Hyperlinks(1).Address，得到的是超連結文件的相對路徑。有時為了VBA代碼的編寫方便，需要使用的是連結文件的絕對路徑。下面通過編寫VBA函數，獲取單元格內超連結文件的絕對路徑。

1 絕對路徑和相對路徑

有兩種方法指定一個文件路徑。

絕對路徑，總是從根文件夾開始。

相對路徑，它相對於程序的當前工作目錄。

       對於點（.）和點點（..）文件夾，它們不是真正的文件夾，而是可以在路徑中使用的特殊名稱。單個的句點（「點」）用作文件夾目錄名稱時，是「這個目錄」的縮寫。兩個句點（「點點」）的意思是父文件夾。

下圖是一些文件和文件夾的例子。如果當前工作目錄設置為C:\bacon，這些文件夾和文件的相對目錄，就表示為下圖所示的樣子。

相對路徑開始處的.\是可選的。例如，.\spam.txt和spam.txt指的是同一個文件。

回到VBA，通過ThisWorkbook.Path，可以獲取當前工作簿所在工作目錄的路徑；通過Hyperlinks(1).Address，得到的是基於ThisWorkbook.Path的相對路徑；通過ThisWorkbook.Path拼接相對路徑，可以得到目標文件的絕對路徑。

2 函數編寫

針對單元格內的超連結，本文暫不考慮共享文件夾的情況，連結的文件可以分為以下三種情況：

在同一工作目錄內；

在同一個公共盤，不在同一工作目錄內；

不在同一公共盤。

 如果單元格連結的是本工作簿內的單元格，則Hyperlinks(1).Address得到的是空字符串。

相對路徑轉化為絕對路徑的函數代碼如下所示：

Function getAbsolutePath(target As Range) As String

    Dim relativepath As String, arr_thisbook() As String, arr_relative() As String
    Dim ii As Integer, num_thisbook As Integer, initial_relative As Integer, num_relative As Integer
    Dim new_thisbook() As String, new_relative() As String

    If target.Hyperlinks.Count = 0 Then
    
        getAbsolutePath = "無連結"
        
    ElseIf target.Hyperlinks.Count = 1 Then
    
        '獲取相對路徑
        relativepath = target.Hyperlinks(1).Address
        
        '連結在本工作簿內
        If relativepath = "" Then
        
            getAbsolutePath = "本工作簿內"
            
        '連結其他盤
        ElseIf Left(relativepath, 3) Like "?:\" Then
        
            '完整路徑
            getAbsolutePath = relativepath
        
        '連結在同一個盤，不在同一工作目錄內
        ElseIf Left(relativepath, 3) Like "..\" Then
        
            arr_thisbook = Split(ThisWorkbook.Path, "\")
            num_thisbook = UBound(arr_thisbook)
            
            arr_relative = Split(relativepath, "\")
            initial_relative = 0
            num_relative = UBound(arr_relative)
            
            For ii = 0 To UBound(arr_relative)
            
                If arr_relative(ii) = ".." Then
                
                    num_thisbook = num_thisbook - 1
                    
                    initial_relative = initial_relative + 1
                    num_relative = num_relative - 1
                
                End If
            
            Next
            
            ReDim new_thisbook(0 To num_thisbook)
            ReDim new_relative(0 To num_relative)
            
            For ii = 0 To num_thisbook
            
                new_thisbook(ii) = arr_thisbook(ii)
            
            Next
            
            For ii = 0 To num_relative
            
                new_relative(ii) = arr_relative(initial_relative + ii)
            
            Next
            
            getAbsolutePath = Join(new_thisbook, "\") & "\" & Join(new_relative, "\")
            
            
        '連結在同一工作目錄內
        Else
        
            getAbsolutePath = ThisWorkbook.Path & "\" & relativepath
        
        End If
    
    End If

End Function
示例：
參考資料：
[1] VBA中的相對路徑（https://www.jianshu.com/p/8c51c723d1d6）
[2] Python編程快速上手: 讓繁瑣工作自動化（https://github.com/Ibuki-Suika/Books-3/blob/master/Python/Python%E7%BC%96%E7%A8%8B%E5%BF%AB%E9%80%9F%E4%B8%8A%E6%89%8B%20%E8%AE%A9%E7%B9%81%E7%90%90%E5%B7%A5%E4%BD%9C%E8%87%AA%E5%8A%A8%E5%8C%96.pdf）
[3] READING AND WRITING FILES（https://automatetheboringstuff.com/2e/chapter9/）
[4] Excel Hyperlink Object Address Property only shows relative path（https://www.tek-tips.com/viewthread.cfm?qid=1107468）
[5] excelvba打開文件夾路徑（http://www.officexr.com/c/56602.html）
[6] Join function（https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/join-function）