Gustav Brock
gustav at cactus.dk
Wed Oct 22 14:54:04 CDT 2003
Hi all We had a need for a bulletproof method to retrieve the path from a full filename or from a path with no filename. Much to my surprise, all the "quickies" I could locate around the net (including so called expert and guru sites) and the FileSystem object as well fail for one or more common structures like UNC paths and/or relative paths. Also, this was for "air" filenames which may not yet exist so any use of Dir() and the like was out of the question. Further, InStrRev() could not be used as it was for A97. Below is the function. Any comments - indeed those on bugs or misbehaviour - are appreciated. Beware of line breaks. /gustav PS: A _really_ freaky class implementation which I didn't even consider to port and test is found here: http://www.xbeat.net/vbspeed/cod_GetChris.htm <code> Public Function GetPathOfFile(ByVal strFile As String) As String ' Returns path of full filename. ' Accepts relative path and UNC names. ' Examples: ' ' c:\name c:\ ' c:\name\ c:\name\ ' c:\name\file c:\name\ ' c:name c: ' c:name\ c:name\ ' c:name\file c:name\ ' c: c: ' c:\ c:\ ' \name \ ' \name\ \name\ ' \name\file \name\ ' .\ .\ ' .\name .\ ' .\name\ .\name\ ' .\name\file .\name\ ' ..\ ..\ ' ..\name ..\ ' ..\name\ ..\name\ ' ..\name\file ..\name\ ' \\fs1 \\fs1 ' \\fs1\ \\fs1\ ' \\fs1\name \\fs1\ ' \\fs1\name\ \\fs1\name\ ' \\fs1\name\file \\fs1\name\ ' vbNullString vbNullString ' 2003-10-21. Cactus Data ApS. CPH. Const cstrChrBackslash As String * 1 = "\" Const cstrChrColon As String * 1 = ":" Const clngUNCHeader As Long = 2 Dim lngPos As Long Dim lngPosPrev As Long Dim lngPosMin As Long Dim strPath As String If StrComp(Left(strFile, clngUNCHeader), String(clngUNCHeader, cstrChrBackslash), vbBinaryCompare) = 0 Then ' Full name is an UNC path. ' Skip leading double slash. lngPosMin = clngUNCHeader End If ' Search for last backslash in full name. Do lngPosPrev = lngPos lngPos = InStr(1 + lngPos + lngPosMin, strFile, cstrChrBackslash, vbBinaryCompare) Loop While lngPos > 0 If lngPosPrev > 0 Then ' UNC server or drive letter. Path specified in full. strPath = Left(strFile, lngPosPrev) ElseIf lngPosMin = 0 Then ' Current (not known) dir of drive. ' Return drive letter only with no trailing backslash. strPath = Left(strFile, InStr(strFile, cstrChrColon)) Else ' UNC server name only. strPath = strFile End If GetPathOfFile = strPath End Function </code>