VBA Determines if a string is a file, folder, or web address.

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

FYI - for a file, I copy the file to the repository, for the folder I make the .lnk shortcut and copy it to the repository, and for the web url I make the .url shortcut and copy its storage.

I developed a solution, but it is not stable enough; I get a random error from incorrect string identification. The method I used consisted of counting points in a row and applying the rule:

If Dots = 1 Then... it a file. If Dots < 1 Then... it a folder. If Dots > 1 Then... it a website. 

Then I improved it using a couple of functions that I found on the Internet:

 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 

The problem is that I am still having problems with two circumstances:

  • When file names contain additional periods, for example. \Report.01.doc

  • When the line is a file or folder in a remote location on the intranet (I think it might be incorrectly identified as a web url).

Any pointers in the right direction would be highly appreciated.

Tom x

+4
source share
1 answer

This may solve your problem or at least lead you to one thing:

 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 
+4
source

Source: https://habr.com/ru/post/1401660/


All Articles