4

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

ScottJShea
  • 7,041
  • 11
  • 44
  • 67
FrugalTPH
  • 533
  • 2
  • 6
  • 25
  • 1
    You might like to look at http://stackoverflow.com/questions/161738/what-is-the-best-regular-expression-to-check-if-a-string-is-a-valid-url – Fionnuala Mar 15 '12 at 20:11
  • Thanks for the response. Are the regular expressions methods available in VBA? This looks as though it could do what I'm after. – FrugalTPH Mar 16 '12 at 13:31
  • 1
    Yes, they are `CreateObject("vbscript.regexp")` or set a reference to the Windows Script Host Object. You will find lots of regex expression for this kind of thing. You might also like to look at the FileSystemObject. It has quite a few nice methods. – Fionnuala Mar 16 '12 at 13:38

2 Answers2

5

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
bPratik
  • 6,894
  • 4
  • 36
  • 67
  • Thanks for the response. I am using the Allen Browne parts of this code already for the file & folder checks. I have 2 questions. (a) I assume the line... If (retval = "I") And HttpExists(path) Then retval = "F" Should read: If (retval = "I") And HttpExists(path) Then retval = "U" (b) I assume the http method is kind of attempting to ping the page. What would be the implications for https and ftp, in this case? Would a true response still be generated? – FrugalTPH Mar 16 '12 at 13:38
  • Yes it's a typo, it should have been a `retval = "U"`. For the other part of your question, yes `HTTPS` and `FTP` generate similar, if not the same, status codes: http://en.wikipedia.org/wiki/List_of_FTP_server_return_codes – bPratik Mar 16 '12 at 14:26
  • I have this working now. I omitted the "trailing slash" function (which isn't actually called), and I added 1 line to the very end of the FileExists function... If Len(strFile) < 3 Then CheckFileExists = False". This catches such as "C:\" as input, which misidentified as a file. Had a problem with CreateObject("MSXML2.XMLHTTP") not working, and had to use MSXML2.SERVERXMLHTTP instead. All appears to be working nicely now. Thanks for the help. – FrugalTPH Mar 16 '12 at 16:24
  • 1
    @FrugalTPH I have been using MSXML2.XMLHTTP60 with great success, instead of CreateObject("MSXML2.XMLHTTP") – skatun Oct 11 '16 at 06:29
  • I thing you should write a function called `isFolder` or `isFile` as asked by the author. – Marinos An Jun 11 '21 at 17:42
1

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.

C Tauss
  • 88
  • 4