使用我的代码,我必须编写一个文件名来搜索:“test.txt”。它工作正常,返回与所选路径中存在的 test.txt 一样多。
我希望它能够搜索:“txt”并获取所选路径中的所有 .txt 文件。
我的代码:
Option Explicit
Dim fso As New FileSystemObject
Dim fld As Folder
Private Sub Command1_Click()
Dim nDirs As Long, nFiles As Long, lSize As Currency
Dim sDir As String, sSrchString As String
sDir = InputBox("Type the directory that you want to search for", _
"FileSystemObjects example", "C:\")
sSrchString = InputBox("Type the file name that you want to search for", _
"FileSystemObjects example", "")
' MousePointer = vbHourglass
' Label1.Caption = "Searching " & vbCrLf & UCase(sDir) & "..."
lSize = FindFile(sDir, sSrchString, nDirs, nFiles)
' MousePointer = vbDefault
MsgBox Str(nFiles) & " files found in" & Str(nDirs) & _
" directories", vbInformation
MsgBox "Total Size = " & lSize & " bytes"
End Sub
Private Function FindFile(ByVal sFol As String, sFile As String, _
nDirs As Long, nFiles As Long) As Currency
Dim tFld As Folder, tFil As File, FileName As String
On Error GoTo Catch
Set fld = fso.GetFolder(sFol)
FileName = Dir(fso.BuildPath(fld.path, sFile), vbNormal Or _
vbHidden Or vbSystem Or vbReadOnly)
While Len(FileName) <> 0
FindFile = FindFile + FileLen(fso.BuildPath(fld.path, _
FileName))
nFiles = nFiles + 1
' List1.AddItem fso.BuildPath(fld.Path, FileName) ' Load ListBox
FileName = Dir() ' Get next file
DoEvents
Wend
' Label1 = "Searching " & vbCrLf & fld.Path & "..."
nDirs = nDirs + 1
If fld.SubFolders.Count > 0 Then
For Each tFld In fld.SubFolders
DoEvents
FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles)
Next
End If
Exit Function
Catch: FileName = ""
Resume Next
End Function
和一个提示,我发现了类似的东西:
For Each file In files
If Right(file, 3) = "pdf" Then
myMailItem.Attachments.Add CStr(file)
found = True
End If
但我无法让它在我的代码中工作。
谢谢!