[發問] dropbox excel vba 絕對路徑改相對路徑

[版主管理留言]

GBKEE(2016/10/20 06:07): 這不是VBA 的程式碼.

dropbox excel vba 絕對路徑改相對路徑

起因是為了檔案安全，重要的檔案都是利用 dropbox 或 google driver 來存放

excel 中會利用到其它檔案，這些檔案是利用 GetOpenFileName 取得絕對路徑，存放在儲存檔之中，然後透過巨集來開啟

重點在於並不是每一台pc dropbox / google driver 的路徑都一樣，這些程式指定的路徑不一樣。

結果會導致，在公司能夠找到檔案，回到家卻找不到（絕對路徑錯誤）

※重點：相對目徑沒錯（都是在 dropbox 下）

所以我想寫個 vba 來做相做處理

例一：
GetOpenFileName path= D:\Dropbox\Dropbox\_Office\__客戶基本資料_.xls
ActiveWorkbook.Path= D:\Dropbox\Dropbox\2016信封
relative path= \..\_Office\__客戶基本資料_.xls

例二
GetOpenFileName path= D:\Dropbox\Dropbox\_Office\__客戶基本資料_.xls
ActiveWorkbook.Path= D:\Dropbox\Dropbox\_Office\月結帳\201609月結
relative path= \..\..\__客戶基本資料_.xls

目前我分析完之後，psuedo code 大概是這樣

for(
從ActiveWorkbook 尋找 \ ，產生從短到長的路徑和GetOpenFileName path 比較，是否有重復

找出最長的路徑後
}
例一：
GetOpenFileName path= D:\Dropbox\Dropbox
ActiveWorkbook.Path= D:\Dropbox\Dropbox
例二
GetOpenFileName path= D:\Dropbox\Dropbox\_Office
ActiveWorkbook.Path= D:\Dropbox\Dropbox\_Office

}
刪除最長路徑

例一：
GetOpenFileName path= \_Office\__客戶基本資料_.xls
ActiveWorkbook.Path= \2016信封
例一：
GetOpenFileName path= \__客戶基本資料_.xls
ActiveWorkbook.Path= \月結帳\201609月結

從ActiveWorkbook.Path 尋找有幾個 \ ，產生幾個 \..
例一：
GetOpenFileName path= \_Office\__客戶基本資料_.xls
ActiveWorkbook.Path= \2016信封
relative path= \..

例二：
GetOpenFileName path= \__客戶基本資料_.xls
ActiveWorkbook.Path= \月結帳\201609月結
relative path= \..\..

再 & GetOpenFileName path
例一：
GetOpenFileName path= \_Office\__客戶基本資料_.xls
ActiveWorkbook.Path= \2016信封
relative path= \..\_Office\__客戶基本資料_.xls

例二：
GetOpenFileName path= \__客戶基本資料_.xls
ActiveWorkbook.Path= \月結帳\201609月結
relative path= \..\..\__客戶基本資料_.xls

能否能有高手指點一下，正確的程式寫法，謝謝

樓主熱帖

公開經驗，創造智慧（我又不靠這過活）

eigen

中學生 Rank: 2

帖子: 79
主題: 33
精華: 0
積分: 123
點名: 0
作業系統: win7
軟體版本: x64
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2013-10-24
最後登錄: 2024-3-28

3^#

發表於 2016-10-20 16:14 | 只看該作者

回復 2# eigen

我自己動手寫出來，適合使用 drobpox / google driver 之類的玩家，開啟預設的檔案，採用相對路徑，可避免其它電腦開啟，找不到檔案的問題。

Private Sub CommandButton1_Click()
Dim ControlFile As String
Dim OpenFile_Input As String
Dim OpenFile_Name As String
Dim OpenFile_Len As Integer
Dim Workbook_Path As String
Dim Workbook_Len As Integer
Dim path_index As Integer
Dim path1 As String
Dim path2 As String
Dim Relative_Path As String
Dim Match_Path As String
Dim Match_Index As Integer
ControlFile = ActiveWorkbook.Name
Workbook_Path = ActiveWorkbook.Path & "\"
Workbook_Len = Len(Workbook_Path)
OpenFile_Input = ""
OpenFile_Input = Application.GetOpenFilename("EXCE檔(*.XLS),*xls")
OpenFile_Len = Len(OpenFile_Input)
OpenFile_Name = Right(OpenFile_Input, OpenFile_Len - InStrRev(OpenFile_Input, "\"))
If OpenFile_Input <> "" And OpenFile_Input <> "False" Then
For path_index = 1 To Workbook_Len
path1 = Left(Workbook_Path, path_index)
path2 = Left(OpenFile_Input, path_index)
If path1 = path2 Then
Match_Path = path1 '找出重復的路徑及長度
Match_Index = path_index '找出重復的路徑及長度
End If
Next
Match_Path = Left(Match_Path, InStrRev(Match_Path, "\")) '計算出正確的重復路徑
path1 = Right(Workbook_Path, Workbook_Len - Len(Match_Path))
path2 = Right(OpenFile_Input, OpenFile_Len - Len(Match_Path)) '刪除重復的路徑
Relative_Path = "" '計算幾個 "\"，產生幾個"\.."
For path_index = 1 To Len(path1)
If Mid(path1, path_index, 1) = "\" Then
Relative_Path = Relative_Path & "\.."
End If
Next
If Match_Path = "" Or Match_Index = 3 Then '不同磁碟或無重復路徑，直接顯示 Absolute Path
Relative_Path=OpenFile_Input
Else
Relative_Path = Relative_Path & "\" & path2 '產生最後的路徑
EndIf
MsgBox "Reference " & OpenFile_Input & vbCrLf & vbCrLf & Relative_Path & vbCrLf & vbCrLf & Workbook_Path & vbCrLf & vbCrLf & OpenFile_Input
Range("P2").Value = Relative_Path
Range("P3").Value = "[" & OpenFile_Name & "]"
Workbooks.Open OpenFile_Input
Windows(ControlFile).Activate
Sheets("月結地址").Range("A2").Select
End If
End Sub