View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
NickHK NickHK is offline
external usenet poster
 
Posts: 4,391
Default VBA compare two file paths and delete common root

Susan,
I was under the impression there was an API call that does this, but I can't
find it now - or my memory is faulty and it does not actually exist.
Not sure if this is 100% correct, but you get the idea:

Declare Function PathIsSameRoot Lib "shlwapi.dll" Alias "PathIsSameRootA" _
(ByVal pszPath1 As String, _
ByVal pszPath2 As String) _
As Long


Public Function MakePathRelative(PathToFix As String, RelativeToPath As
String, Optional Delim As String = "\") As String
Dim RelToParts() As String
Dim FixParts() As String
Dim MinParts As Long
Dim RelToLonger As Boolean
Dim i As Long
Dim Temp As String

If PathIsSameRoot(PathToFix, RelativeToPath) = False Then
MakePathRelative = ""
Exit Function
End If

RelToParts = Split(RelativeToPath, Delim)
FixParts = Split(PathToFix, Delim)

If UBound(RelToParts) UBound(FixParts) Then
MinParts = UBound(FixParts)
Else
MinParts = UBound(RelToParts)
End If

For i = LBound(FixParts) To MinParts
If RelToParts(i) = FixParts(i) Then
Temp = Temp & RelToParts(i) & Delim
Else
Exit For
End If
Next

MakePathRelative = WorksheetFunction.Rept("..\", UBound(RelToParts) - i + 1)
& Mid(PathToFix, Len(Temp) + 1)

End Function

Some other API that you may want to include to check the validity of input:

Declare Function PathIsRelative Lib "shlwapi.dll" Alias "PathIsRelativeA"
(ByVal pszPath As String) As Long
Declare Function PathCanonicalize Lib "shlwapi.dll" Alias
"PathCanonicalizeA" (ByVal pszBuf As String, ByVal pszPath As String) As
Long
Private Declare Function PathIsDirectory Lib "shlwapi.dll" Alias
"PathIsDirectoryA" (ByVal pszPath As String) As Long
Private Declare Function PathIsLFNFileSpec Lib "shlwapi.dll" Alias
"PathIsLFNFileSpecA" (ByVal lpName As String) As Long
Private Declare Function PathIsNetworkPath Lib "shlwapi.dll" Alias
"PathIsNetworkPathA" (ByVal pszPath As String) As Long
Private Declare Function PathIsRoot Lib "shlwapi.dll" Alias "PathIsRootA"
(ByVal pszPath As String) As Long

NickHK

"SusanForson" wrote in message
...
I need a method for comparing two file paths and removing the common root.
Specifically, I want to create a relative path from one file to another.

I do not know in advance what the file path is or how long it is. The

files
may be of different types. A typical example might be:

Path1 = S:\Workgroups\Engineering\Graphics\Pictures\Overvi ew.bmp

Path2 = S:\Workgroups\Engineering\Trends\Spreadsheet.xls

Path3 = S:\Workgroups\Engineering\Graphics\Pictures\Sheets \Report.doc

I want to set Path1 to be the "home" location. The relative path for

Path1
in my example would be:

.\Overview.bmp

The relative path from Path1 to Path2 would be:

...\Trends\Spreadsheet.xls

The relative path from Path1 to Path3 would be:

.\Sheets\Report.doc


First, I need to identify the common root. In my example, the common root

is:

S:\Workgroups\Engineering\

Second, I need to replace my "Home" path path with ".\filename.ext"
In my example, I need to change my "Home" path to ".\Overview.bmp"

Third, I need to know if the path being compared is in a folder up or down
from the "home" file.

Replace EACH FOLDER ONE LEVEL UP from my "home" file with a "."

I need to replace EACH FOLDER ONE LEVEL DOWN from my "home" file -or- from
the common root with the name of the folder.

I have played with various versions of the split function, LEN(), INSTR(),
INSTREV(), LEFT(), RIGHT(), MID(), vbTextCompare, etc. without success. I
can get the full file and path name without a problem an create the "Home"
file name. It's the comparison that is tripping me up.

Any help you could provide would be greatly appreciated.

Susan Forson