[AccessD] Get path from full file name

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>



More information about the AccessD mailing list