文章背景：在工作中，有時為了内容跳轉的友善，會在單元格内設定
超連結
，通過
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 複制
示例：http://mpvideo.qpic.cn/0bf2vaaaaaaagmajgtbqknqvbkgdacuaaaaa.f10002.mp4?dis_k=e9ae6347a820899e8e0fbafb206c0c1a&dis_t=1663655862&vid=wxv_2029727663875063809&format_id=10002&support_redirect=0&mmversion=false
參考資料：
[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）