VBA - 文字列がファイル、フォルダ、またはWeb URLであるかどうかを確認する

Question

文字列が渡されることによって開始され、文字列がファイルであるかどうかに応じて、フォルダまたはWebのURL。

FYI - ファイルの場合リポジトリにファイルをコピーするフォルダの場合、ショートカット.lnkを作成してリポジトリにコピーし、ウェブ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 

トラブルがあり、私はまだ2つの状況で問題があります：

1. ファイル名に追加のドットが含まれる場合\Report.01.doc

2. 文字列がリモートイントラネット上のファイルまたはフォルダの場合（これはWeb URLとして誤っている可能性があります）。

正しい方向のポインタがあれば幸いです。

トム・H

Answer 1

これはあなたの問題を解決する可能性があります、または少なくとも一つにあなたを導く：

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