我需要执行许多操作,由传递字符串启动,操作过程取决于字符串是文件、文件夹还是 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
任何指向正确方向的指针将不胜感激。
汤姆·H
最佳答案
这可能会解决您的问题,或者至少会引导您解决一个问题:
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
关于string - VBA - 识别字符串是文件、文件夹还是网址,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/9724779/