Board logo

標題: [發問] dropbox excel vba 絕對路徑 改 相對路徑 [打印本頁]
作者: eigen    時間: 2016-10-20 03:10     標題: dropbox excel 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    時間: 2016-10-20 13:00

這是 pseudo code ，我寫 vba 的能力沒這麼好，無法快速  coding 出想法~~
作者: eigen    時間: 2016-10-20 16:14

回復 2# eigen

我自己動手寫出來 ，適合使用 drobpox / google driver 之類的玩家，開啟預設的檔案，採用相對路徑，可避免其它電腦開啟，找不到檔案的問題。
  1. Private Sub CommandButton1_Click()
  2.         Dim ControlFile As String

  4.         Dim OpenFile_Input As String
  5.         Dim OpenFile_Name As String
  6.         Dim OpenFile_Len As Integer

  8.         Dim Workbook_Path As String
  9.         Dim Workbook_Len As Integer

  11.         Dim path_index As Integer
  12.         Dim path1 As String
  13.         Dim path2 As String
  14.         Dim Relative_Path As String
  15.         Dim Match_Path As String
  16.         Dim Match_Index As Integer

  18.         ControlFile = ActiveWorkbook.Name
  19.         Workbook_Path = ActiveWorkbook.Path & "\"
  20.         Workbook_Len = Len(Workbook_Path)

  22.         OpenFile_Input = ""
  23.         OpenFile_Input = Application.GetOpenFilename("EXCE檔(*.XLS),*xls")
  24.         OpenFile_Len = Len(OpenFile_Input)
  25.         OpenFile_Name = Right(OpenFile_Input, OpenFile_Len - InStrRev(OpenFile_Input, "\"))

  27.         If OpenFile_Input <> "" And OpenFile_Input <> "False" Then

  29.                 For path_index = 1 To Workbook_Len
  30.                         path1 = Left(Workbook_Path, path_index)
  31.                         path2 = Left(OpenFile_Input, path_index)
  32.                         If path1 = path2 Then
  33.                                 Match_Path = path1                                              '找出重復的路徑及長度
  34.                                 Match_Index = path_index                                        '找出重復的路徑及長度
  35.                         End If
  36.                 Next

  38.                 Match_Path = Left(Match_Path, InStrRev(Match_Path, "\"))                        '計算出正確的重復路徑
  39.                 path1 = Right(Workbook_Path, Workbook_Len - Len(Match_Path))
  40.                 path2 = Right(OpenFile_Input, OpenFile_Len - Len(Match_Path))                   '刪除重復的路徑

  42.                 Relative_Path = ""                                                              '計算幾個 "\"，產生幾個"\.."
  43.                 For path_index = 1 To Len(path1)
  44.                         If Mid(path1, path_index, 1) = "\" Then
  45.                                 Relative_Path = Relative_Path & "\.."
  46.                         End If
  47.                 Next

  49.                 If Match_Path = "" Or Match_Index = 3 Then                                      '不同磁碟 或 無重復路徑，直接顯示 Absolute Path
  50.                         Relative_Path=OpenFile_Input
  51.                 Else
  52.                         Relative_Path = Relative_Path & "\" & path2                             '產生最後的路徑
  53.                 EndIf


  56.                 MsgBox "Reference " & OpenFile_Input & vbCrLf & vbCrLf & Relative_Path & vbCrLf & vbCrLf & Workbook_Path & vbCrLf & vbCrLf & OpenFile_Input

  58.                 Range("P2").Value = Relative_Path
  59.                 Range("P3").Value = "[" & OpenFile_Name & "]"

  61.                 Workbooks.Open OpenFile_Input
  62.                 Windows(ControlFile).Activate
  63.                 Sheets("月結地址").Range("A2").Select


  66.         End If

  68. End Sub
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)