Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA compare two file paths and delete common root
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA compare two file paths and delete common root
Susan,
And if you need to go the other way to combine an absolute with a relative, try this: Declare Function PathCombine Lib "shlwapi.dll" Alias "PathCombineA" _ (ByVal szDest As String, _ ByVal lpszDir As String, _ ByVal lpszFile As String) _ As Long Public Function TestRelativePath(Base As String, Rest As String) As String Dim Temp As String Const MAX_PATH = 255 Temp = String(MAX_PATH, 0) PathCombine Temp, Base, Rest TestRelativePath = StripTerminator(Temp) End Function 'Remove all trailing Chr$(0)'s Function StripTerminator(sInput As String) As String Dim ZeroPos As Long ZeroPos = InStr(1, sInput, Chr$(0)) If ZeroPos 0 Then StripTerminator = Left$(sInput, ZeroPos - 1) Else StripTerminator = sInput End If End Function You will find the API-Guide invaluable for these declaration and examples: Their site at http://www.allapi.net/ seems to been taken over, so I can't tell you where to get it now, but a search should show some other sites. NickHK "NickHK" wrote in message ... 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
VBA compare two file paths and delete common root
Thanks for the prompt reply. I will try it and let you know. Sometimes I
wonder why I beat myself up so long before I ask for help - you guys are AWESOME! Susan "NickHK" wrote: Susan, And if you need to go the other way to combine an absolute with a relative, try this: Declare Function PathCombine Lib "shlwapi.dll" Alias "PathCombineA" _ (ByVal szDest As String, _ ByVal lpszDir As String, _ ByVal lpszFile As String) _ As Long Public Function TestRelativePath(Base As String, Rest As String) As String Dim Temp As String Const MAX_PATH = 255 Temp = String(MAX_PATH, 0) PathCombine Temp, Base, Rest TestRelativePath = StripTerminator(Temp) End Function 'Remove all trailing Chr$(0)'s Function StripTerminator(sInput As String) As String Dim ZeroPos As Long ZeroPos = InStr(1, sInput, Chr$(0)) If ZeroPos 0 Then StripTerminator = Left$(sInput, ZeroPos - 1) Else StripTerminator = sInput End If End Function You will find the API-Guide invaluable for these declaration and examples: Their site at http://www.allapi.net/ seems to been taken over, so I can't tell you where to get it now, but a search should show some other sites. NickHK "NickHK" wrote in message ... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How do i compare and remove common names from 2 excel work sheets | Excel Worksheet Functions | |||
Compare two worksheets and identify common entries | Excel Discussion (Misc queries) | |||
Compare two wk sheets with common data using copy paste macro | Excel Worksheet Functions | |||
excel file paths | Excel Discussion (Misc queries) | |||
file paths | Excel Discussion (Misc queries) |