VBA - 判断字符串是文件、文件夹还是网址

Question

VBA - 判断字符串是文件、文件夹还是网址

4

我需要执行一些动作，这些动作由传递的字符串启动，并且根据该字符串是文件、文件夹还是web url来决定采取哪些动作。

对于文件，我将文件复制到存储库中；对于文件夹，我正在创建一个快捷方式.lnk并将其复制到存储库中；对于web url，我正在创建一个快捷方式.url并将其复制到存储库中。

我开发了一个解决方案，但它不够健壮；我会偶尔出现误识别字符串的错误。我使用的方法是计算字符串中的点数，并应用以下规则：

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

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

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

我后来发现了一些网络上的函数，通过使用它们我进一步改进了它：

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

问题是，我仍然在处理两种情况时遇到问题：

当文件名包含额外的点时，例如 \Report.01.doc
当字符串是远程内部网络位置上的文件夹或文件时（我认为这可能会误识别为Web URL）。

非常感谢您提供任何有关正确方向的指导。

汤姆 H

- FrugalTPH

1

你可能想看一下https://dev59.com/NHVC5IYBdhLWcg3w21Iq - Fionnuala

谢谢您的回复。VBA中是否有正则表达式方法可用？看起来这似乎可以做到我想要的。 - FrugalTPH

1

是的，它们是 CreateObject("vbscript.regexp") 或者设置对 Windows Script Host 对象的引用。你会发现很多正则表达式可以用于这种情况。你也可以看看 FileSystemObject。它有很多不错的方法。 - Fionnuala

2个回答

1

这里有一个更简单的方法。

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

这需要在VBA编辑器的工具-〉引用中选择Microsoft脚本运行库。您可以使用之前使用HTTP库的代码来检查这是否是有效的URL，而不仅仅是随机文本。

- C Tauss

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- bPratik · Accepted Answer

这可能可以解决你的问题，或者至少引导你找到一个解决方案：

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