在 MSWord 中使用 VBA 搜索文件
Search for file using VBA in MSWord
我需要我的宏在不知道完整文件路径的情况下搜索特定文件,然后打开文件或 return 文件路径。我试过在线搜索,但大多数答案似乎对我不起作用。我得到的最接近的是搜索文件夹的功能,但我无法修改它来搜索文件
(由 https://vbahowto.com/how-to-search-for-a-folder-in-vba/ 提供)。
Sub Main()
Dim fsoFileSystem As Object
Dim strMainFolder As String
Dim strLookFor As String
strLookFor = "working"
strMainFolder = "C:\a"
Set fsoFileSystem = CreateObject("Scripting.FileSystemObject")
DoSubFolders fsoFileSystem.GetFolder(strMainFolder), strLookFor
'if the code didn't find the folder, you will get this message.
Msgbox "'" & strLookFor & "' is not found so go ahead and create it.", vbInformation
End Sub
Sub DoSubFolders(Folder, strLookFor)
Dim objSubFolder As Object
For Each objSubFolder In Folder.SubFolders
Debug.Print "*****************************************"
Debug.Print "SubFolder= " & objSubFolder.Name
Debug.Print "*****************************************"
If objSubFolder.Name = strLookFor Then
MsgBox "You already have a folder called '" & strLookFor & "' at '" & objSubFolder.Path & "' . Don't add it again.", vbInformation
'Exit the search
End
End If
DoSubFolders objSubFolder, strLookFor
Next
Dim objFile As Object
For Each objFile In Folder.Files
' Operate on each file
Debug.Print "FileName= " & objFile.Name
Next
End Sub
这是一个非递归版本:
Sub FindFile()
'Define the file name and main folder
Const strLookFor As String = "working"
Const strMainFolder As String = "C:\a"
Dim targetFilePath As String
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim folderColl As Collection
Set folderColl = New Collection
folderColl.Add strMainFolder
Do While folderColl.Count <> 0 And targetFilePath = vbNullString
Dim searchFolder As Object
Set searchFolder = FSO.GetFolder(folderColl(1))
'Look for the file
Dim loopFile As Object
For Each loopFile In searchFolder.Files
If FSO.GetBaseName(loopFile.Name) = strLookFor Then
targetFilePath = loopFile.Path
Exit For
End If
Next loopFile
'Add current folder's subfolders into the collection
Dim loopFolder As Object
For Each loopFolder In searchFolder.SubFolders
folderColl.Add loopFolder.Path
Next loopFolder
folderColl.Remove 1
Loop
'Check if the file is found
If targetFilePath <> vbNullString Then
MsgBox "File found." & vbNewLine & targetFilePath
Else
MsgBox "File not found."
End If
End Sub
编辑 - 函数版本:
Sub Main()
Dim strLookFor As String
Dim strMainFolder As String
strLookFor = "working"
strMainFolder = "D:\Temp\FindFile"
Dim targetFilePath As String
targetFilePath = FindFile(strMainFolder, strLookFor)
'Check if the file is found
If targetFilePath <> vbNullString Then
MsgBox "File found." & vbNewLine & targetFilePath
Else
MsgBox "File not found."
End If
End Sub
Function FindFile(strMainFolder As String, strLookFor As String) As String
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim folderColl As Collection
Set folderColl = New Collection
folderColl.Add strMainFolder
Do While folderColl.Count <> 0
Dim searchFolder As Object
Set searchFolder = FSO.GetFolder(folderColl(1))
'Look for the file
Dim loopFile As Object
For Each loopFile In searchFolder.Files
If FSO.GetBaseName(loopFile.Name) = strLookFor Then
FindFile = loopFile.Path
Exit Function
End If
Next loopFile
'Add current folder's subfolders into the collection
Dim loopFolder As Object
For Each loopFolder In searchFolder.SubFolders
folderColl.Add loopFolder.Path
Next loopFolder
folderColl.Remove 1
Loop
End Function
我需要我的宏在不知道完整文件路径的情况下搜索特定文件,然后打开文件或 return 文件路径。我试过在线搜索,但大多数答案似乎对我不起作用。我得到的最接近的是搜索文件夹的功能,但我无法修改它来搜索文件 (由 https://vbahowto.com/how-to-search-for-a-folder-in-vba/ 提供)。
Sub Main()
Dim fsoFileSystem As Object
Dim strMainFolder As String
Dim strLookFor As String
strLookFor = "working"
strMainFolder = "C:\a"
Set fsoFileSystem = CreateObject("Scripting.FileSystemObject")
DoSubFolders fsoFileSystem.GetFolder(strMainFolder), strLookFor
'if the code didn't find the folder, you will get this message.
Msgbox "'" & strLookFor & "' is not found so go ahead and create it.", vbInformation
End Sub
Sub DoSubFolders(Folder, strLookFor)
Dim objSubFolder As Object
For Each objSubFolder In Folder.SubFolders
Debug.Print "*****************************************"
Debug.Print "SubFolder= " & objSubFolder.Name
Debug.Print "*****************************************"
If objSubFolder.Name = strLookFor Then
MsgBox "You already have a folder called '" & strLookFor & "' at '" & objSubFolder.Path & "' . Don't add it again.", vbInformation
'Exit the search
End
End If
DoSubFolders objSubFolder, strLookFor
Next
Dim objFile As Object
For Each objFile In Folder.Files
' Operate on each file
Debug.Print "FileName= " & objFile.Name
Next
End Sub
这是一个非递归版本:
Sub FindFile()
'Define the file name and main folder
Const strLookFor As String = "working"
Const strMainFolder As String = "C:\a"
Dim targetFilePath As String
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim folderColl As Collection
Set folderColl = New Collection
folderColl.Add strMainFolder
Do While folderColl.Count <> 0 And targetFilePath = vbNullString
Dim searchFolder As Object
Set searchFolder = FSO.GetFolder(folderColl(1))
'Look for the file
Dim loopFile As Object
For Each loopFile In searchFolder.Files
If FSO.GetBaseName(loopFile.Name) = strLookFor Then
targetFilePath = loopFile.Path
Exit For
End If
Next loopFile
'Add current folder's subfolders into the collection
Dim loopFolder As Object
For Each loopFolder In searchFolder.SubFolders
folderColl.Add loopFolder.Path
Next loopFolder
folderColl.Remove 1
Loop
'Check if the file is found
If targetFilePath <> vbNullString Then
MsgBox "File found." & vbNewLine & targetFilePath
Else
MsgBox "File not found."
End If
End Sub
编辑 - 函数版本:
Sub Main()
Dim strLookFor As String
Dim strMainFolder As String
strLookFor = "working"
strMainFolder = "D:\Temp\FindFile"
Dim targetFilePath As String
targetFilePath = FindFile(strMainFolder, strLookFor)
'Check if the file is found
If targetFilePath <> vbNullString Then
MsgBox "File found." & vbNewLine & targetFilePath
Else
MsgBox "File not found."
End If
End Sub
Function FindFile(strMainFolder As String, strLookFor As String) As String
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim folderColl As Collection
Set folderColl = New Collection
folderColl.Add strMainFolder
Do While folderColl.Count <> 0
Dim searchFolder As Object
Set searchFolder = FSO.GetFolder(folderColl(1))
'Look for the file
Dim loopFile As Object
For Each loopFile In searchFolder.Files
If FSO.GetBaseName(loopFile.Name) = strLookFor Then
FindFile = loopFile.Path
Exit Function
End If
Next loopFile
'Add current folder's subfolders into the collection
Dim loopFolder As Object
For Each loopFolder In searchFolder.SubFolders
folderColl.Add loopFolder.Path
Next loopFolder
folderColl.Remove 1
Loop
End Function