[AccessD] Get path from full file name

Well here is my little GetPath routine which does not use InstrRev either,
but seems a lot simpler than yours. It also returns the same results as your
function ...

Function GetPath(aPath) As String
' Strips the path name from the supplied file and path name
' leaves the trailing slash on there
Dim foo As Integer, aSlash As Integer
    aSlash = 0
    foo = InStr(aPath, "\")
    While (foo > 0)
        aSlash = foo
        foo = InStr(aSlash + 1, aPath, "\")
    Wend
    If aSlash > 0 Then
        GetPath = Left$(aPath, aSlash)
    Else
        GetPath = aPath
    End If
End Function

This little routine was written before I'd written a version of InstrRev for
Access97...

Function InStrR(varText As Variant, strFind As String) As Integer
   Dim n As Integer, nStart As Integer
    n = Len(strFind)
    If IsNull(varText) Or n = 0 Then
        InStrR = 0
        Exit Function
    End If
    nStart = Len(varText) - n
    While nStart > 0
        n = InStr(nStart, varText, strFind)
        If n = 0 Then
            nStart = nStart - 1
        Else
            InStrR = n
            Exit Function
        End If
    Wend
    InStrR = 0
End Function

Lambert

> -----Original Message-----
> From:	Gustav Brock [SMTP:gustav at cactus.dk]
> Sent:	Wednesday, October 22, 2003 3:54 PM
> To:	AccessD at databaseadvisors.com
> Subject:	[AccessD] Get path from full file name
> 
> 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>
> 
> _______________________________________________
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com