VBA - Identifying whether a string is a file, a folder or a web url

Question

I need to perform a number of actions, initiated by the passing of a string, with the course of actions depending on whether the string is a file, a folder or a web url.

FYI - for a file I copy the file to a repository, for a folder I am making a shortcut .lnk and copy that to a repository, and for a web url I am making a shortcut .url and copy that to a repository.

I developed a solution, but it isn't robust enough; I get the occasional error from misidentifying the string. The method I used was to count the dots in the string, and apply the rule:

If Dots = 1 Then... it's a file.

If Dots < 1 Then... it's a folder.

If Dots > 1 Then... it's a website.

I then improved this using a couple of functions I found on the web:

Dots = Len(TargetPath) - Len(Replace(TargetPath, ".", ""))      ' Crude check for IsURL (by counting Dots)

If CheckFileExists(TargetPath) = True Then Dots = 1             ' Better check for IsFile

If CheckFolderExists(TargetPath) = True Then Dots = 0           ' Better check for IsFolder

Trouble is, I am still having problems with 2 circumstances:

1. When filenames contain additional dots, e.g. \Report.01.doc

2. When the string is a file or folder on a remote intranet location (I think this could be misidentifying as a web url).

Any pointers in the right direction would be much appreciated.

Tom H

Answer 1

This might solve your problem, or atleast lead you to one:

Function CheckPath(path) As String
    Dim retval
    retval = "I"
    If (retval = "I") And FileExists(path) Then retval = "F"
    If (retval = "I") And FolderExists(path) Then retval = "D"
    If (retval = "I") And HttpExists(path) Then retval = "F"
    ' I => Invalid | F => File | D => Directory | U => Valid Url
    CheckPath = retval
End Function
Function FileExists(ByVal strFile As String, Optional bFindFolders As Boolean) As Boolean
    'Purpose:   Return True if the file exists, even if it is hidden.
    'Arguments: strFile: File name to look for. Current directory searched if no path included.
    '           bFindFolders. If strFile is a folder, FileExists() returns False unless this argument is True.
    'Note:      Does not look inside subdirectories for the file.
    'Author:    Allen Browne. http://allenbrowne.com June, 2006.
    Dim lngAttributes As Long

    'Include read-only files, hidden files, system files.
    lngAttributes = (vbReadOnly Or vbHidden Or vbSystem)
    If bFindFolders Then
        lngAttributes = (lngAttributes Or vbDirectory) 'Include folders as well.
    Else
        'Strip any trailing slash, so Dir does not look inside the folder.
        Do While Right$(strFile, 1) = "\"
            strFile = Left$(strFile, Len(strFile) - 1)
        Loop
    End If
    'If Dir() returns something, the file exists.
    On Error Resume Next
    FileExists = (Len(Dir(strFile, lngAttributes)) > 0)
End Function
Function FolderExists(ByVal strPath As String) As Boolean
    On Error Resume Next
    FolderExists = ((GetAttr(strPath) And vbDirectory) = vbDirectory)
End Function
Function TrailingSlash(varIn As Variant) As String
    If Len(varIn) > 0 Then
        If Right(varIn, 1) = "\" Then
            TrailingSlash = varIn
        Else
            TrailingSlash = varIn & "\"
        End If
    End If
End Function
Function HttpExists(ByVal sURL As String) As Boolean
    Dim oXHTTP As Object
    Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
    If Not UCase(sURL) Like "HTTP:*" Then
    sURL = "http://" & sURL
    End If
    On Error GoTo haveError
    oXHTTP.Open "HEAD", sURL, False
    oXHTTP.send
    HttpExists = IIf(oXHTTP.Status = 200, True, False)
    Exit Function
haveError:
    Debug.Print Err.Description
    HttpExists = False
End Function

Answer 2

Here's a simpler approach.

Sub whatAmI()
    Dim s As String
    Dim FSO As New FileSystemObject
    
    s = "C:\FilePath\FolderName"
'    s = "C:\FilePath\FolderName\FileName"
'    s = "www.someURL.com"
    
    If FSO.FolderExists(s) Then
        Debug.Print "Dir"
    ElseIf FSO.FileExists(s) Then
        Debug.Print "File"
    Else
        ' You can use HTTP library to check if existing URL
        Debug.Print "Possible URL"
    End If
End Sub

This requires selecting the Microsoft Scripting Runtime in the VBA Editor under Tools -> References. You can use the previous code that uses the HTTP library to check if this is a valid URL rather then just random text.