Excel VBA初学者求助：实现指定文件夹多格式文件搜索并返回至Sheet2

Hey there! 作为Excel VBA初学者能写出基础的文件搜索功能已经很棒啦～ 咱们来把它扩展成能同时搜索.doc、.docx和.pdf三种格式的版本，直接上修改后的代码和关键说明：

修改后的完整代码 #

Sub SearchMultipleFileFormats()
    ' 定义变量：用户输入的文件名、目标文件夹路径、扩展名数组、当前找到的文件、写入行号
    Dim searchFileName As String
    Dim targetFolder As String
    Dim fileExtensions As Variant
    Dim foundFile As String
    Dim rowNum As Integer
    
    ' 初始化参数
    targetFolder = "G:\NEWFOLDER\NAMEFOLDER\" ' 末尾加\确保路径格式正确
    fileExtensions = Array("*.doc", "*.docx", "*.pdf") ' 要搜索的三种格式
    rowNum = 2 ' 假设Sheet2的第1行是表头，从第2行开始写结果
    
    ' 获取用户输入的文件名（可以保留你原来的输入逻辑，这里用InputBox示例）
    searchFileName = InputBox("请输入要搜索的文件名：")
    If searchFileName = "" Then Exit Sub ' 如果用户取消输入，退出程序
    
    ' 清空Sheet2原有结果（可选，避免重复数据）
    Sheet2.Range("A2:A" & Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row).ClearContents
    
    ' 循环遍历每种文件格式
    For Each ext In fileExtensions
        ' 搜索目标文件夹下包含输入文件名的对应格式文件
        foundFile = Dir(targetFolder & "*" & searchFileName & "*" & ext)
        
        ' 遍历所有找到的文件
        Do While foundFile <> ""
            ' 将文件名写入Sheet2的A列
            Sheet2.Cells(rowNum, "A").Value = foundFile
            rowNum = rowNum + 1 ' 行号自增，准备写下一个结果
            
            ' 查找下一个同格式文件
            foundFile = Dir
        Loop
    Next ext
    
    ' 提示搜索完成
    MsgBox "搜索完成！共找到 " & (rowNum - 2) & " 个文件", vbInformation
End Sub

关键修改点说明 #

• 扩展名数组：用Array("*.doc", "*.docx", "*.pdf")把需要搜索的格式存起来，通过循环逐个处理，不用重复写三次搜索逻辑
• 路径规范：目标文件夹路径末尾加上\，避免拼接文件名时出现格式错误
• 清空旧数据：每次搜索前清空Sheet2之前的结果，防止新旧数据混在一起
• 循环遍历文件：用Do While...Loop配合Dir函数，把同格式下的所有匹配文件都找出来
• 变量命名优化：把原来的NAME改成searchFileName，更直观也避免和潜在关键字冲突

如果你的原有代码里有特定的输入逻辑（比如不是用InputBox而是从单元格获取），只需要把searchFileName = InputBox(...)替换成你原来的代码就行啦～

内容的提问来源于stack exchange，提问作者LitDuck