I have two paths and I want to determine a path that encompasses both directories. For instance, if I have
C:DKIncMemos
then I want to return C:DKinc. This is the most restricted folder I can search, including subfolders, that will include both the Invoices folder and the Memos folder. I thought there would be a really easy way to do this, but I couldn’t think of one. So I came up with this:
Dim i As Long
Dim lLastSlash As Long
If Right$(sPath1, 1) <> “” Then sPath1 = sPath1 & “”
If Right$(sPath2, 1) <> “” Then sPath2 = sPath2 & “”
For i = 1 To Len(sPath1)
If Left$(sPath1, i) <> Left$(sPath2, i) Then
Exit For
End If
Next i
If i = 1 Then ‘no common letters
CommonPath = “”
Else
lLastSlash = InStrRev(Left$(sPath1, i), “”) ‘backup to the directory
If lLastSlash > 0 Then
CommonPath = Left(sPath1, lLastSlash)
Else ‘common letters, but not a whole directory name
CommonPath = “”
End If
End If
End Function
This function simply deals with strings. There’s an assumption that the strings will be paths and no testing to make sure the result is actually a valid path. For the application I need, I have a lot of control over the strings that are passed to this, so I know I’m covered. But to make it a more general purpose function, I think I would need to verify the validity of the path. I’m not sure how it handles UNC either. I was hoping someone would suggest an easier way or suggest what other error checking I’m missing.
Hi Dick,
How about this. Will handle unc path as well
Dim vntP1 As Variant
Dim vntP2 As Variant
Dim lngIndex As Long
vntP1 = Split(Path1, PathDelimit)
vntP2 = Split(Path2, PathDelimit)
For lngIndex = LBound(vntP1) To UBound(vntP1)
If StrComp(vntP1(lngIndex), vntP2(lngIndex), vbTextCompare) 0 Then Exit For
CommonPath2 = CommonPath2 & vntP1(lngIndex) & PathDelimit
Next
End Function
I like Andy’s approach.
I was going to suggest breaking down the first path (Split would do nicely), and then compare using something like:
If Path2 Like Path1 & “*”
rebuilding the Path1 from its components until the match either breaks or is complete.
Aargh. I will bow to the feet of the first person who can explain recursion to me. I get the concept, it’s just that I get lost when I try to compile the code in my head and keep track of what happens when the function calls itself.
It looks so simple and elegant, though.
Interesting capability. I wonder where this would be useful.
Some technical comments:
Dick: Untested: The For I= loop should go to Min(Len(Path1),Len(Path2))
Andy: Also untested: The loop should go to Min(Ubound(vntP1),Ubound(vntP2))
Zach: Since you asked so nicely {grin}, I expedited a planned reorganization of one section of my website. See
Recursion
http://www.tushar-mehta.com/publish_train/book_vba/07_recursion.htm
Good catch Tushar.
Just in case my code caused any confusion regarding recursion, which it does NOT use, I have used a variable to hold the path whilst it is being built.
Dim vntP1 As Variant
Dim vntP2 As Variant
Dim lngIndex As Long
Dim strBuildPath As String
vntP1 = Split(Path1, PathDelimit)
vntP2 = Split(Path2, PathDelimit)
For lngIndex = LBound(vntP1) To WorksheetFunction.Min(UBound(vntP1), UBound(vntP2))
If StrComp(vntP1(lngIndex), vntP2(lngIndex), vbTextCompare) 0 Then Exit For
strBuildPath = strBuildPath & vntP1(lngIndex) & PathDelimit
Next
CommonPath2 = strBuildPath
End Function
Doh! I see I used the markup tags from my usual forum rather those that work here.
Thanks, Tushar. I did not get through it yet, but it looks like it will do the trick.
Andy – I fixed your comment for you. You need to use vb and not vba in the tag. :)
Regards,
Jake
Thanks Jake.
Zach if you are having trouble getting to grips with recursion try to read this simple example.
Its a bit heavy on the annotation but I guess that helps.
I am not entirely happy with it, as it could do with a proper termination flag but I didn’t want to make it too complicated to understand. I have tried to keep it as close to the examples above so the format is easier to pickup.
Just think about it as retracing your steps, and leaving behind some of the baggage you came with.
Function PathFinder(Path1, Path2, Optional PathDelimit As String = “”) As String
Dim strResult As String
If Left(Path1, 1) = Left(Path2, 1) And (Path1 “” Or Path2 “”) Then
‘ The string looks the same so far…
‘ go to the next character
strResult = PathFinder(Mid(Path1, 2), Mid(Path2, 2), PathDelimit)
If strResult = “” Then
‘ The end of the road no futher matches found…..
If Left(Path1, 1) = PathDelimit Then
‘ We have found the end of the matches and we retraced our way back to the delimiter
‘ stick the delimiter on to the results
‘ Basically anything would have done here but I must not return an empty string.
PathFinder = PathDelimit ‘ note path1 = path2
Else
‘ We have found the end of the matches but we haven’t retraced our way back to a delimiter
PathFinder = “”
End If
Else
‘ Everything is matching now lets just keep adding characters one at a time back to the results.
PathFinder = Left(Path1, 1) & strResult
End If
Else
‘ We have found the end of the road this is the first proper difference.
PathFinder = “”
End If
End Function
Zach if you are having trouble getting to grips with recursion try to read this simple example.
Its a bit heavy on the annotation but I guess that helps.
I am not entirely happy with it, as it could do with a proper termination flag but I didn’t want to make it too complicated to understand. I have tried to keep it as close to the examples above so the format is easier to pickup.
Just think about it as retracing your steps, and leaving behind some of the baggage you came with.
Function PathFinder(Path1, Path2, Optional PathDelimit As String = “”) As String Dim strResult As String If Left(Path1, 1) = Left(Path2, 1) And (Path1 “” Or Path2 “”) Then ‘ The string looks the same so far… ‘ go to the next character strResult = PathFinder(Mid(Path1, 2), Mid(Path2, 2), PathDelimit) If strResult = “” Then ‘ The end of the road no futher matches found….. If Left(Path1, 1) = PathDelimit Then ‘ We have found the end of the matches and we retraced our way back to the delimiter ‘ stick the delimiter on to the results ‘ Basically anything would have done here but I must not return an empty string. PathFinder = PathDelimit ‘ note path1 = path2 Else ‘ We have found the end of the matches but we haven’t retraced our way back to a delimiter PathFinder = “” End If Else ‘ Everything is matching now lets just keep adding characters one at a time back to the results. PathFinder = Left(Path1, 1) & strResult End If Else ‘ We have found the end of the road this is the first proper difference. PathFinder = “” End IfEnd Function