Vba在特定文件夹含子文件夹中查找名称包含“附件1-4：华南分公司危大工程2023年05月实施及2023年06月计划清单”的excle表并复制到新地址

以下是一个可供参考的VBA代码示例，可以在特定文件夹及其子文件夹中查找名称包含“附件1-4：华南分公司危大工程2023年05月实施及2023年06月计划清单”的Excel表并复制到新地址：

Sub FindAndCopyExcelFile()
    Dim sourceFolder As String
    Dim targetFolder As String
    Dim fileName As String
    Dim fileExt As String
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objSubFolder As Object
    Dim objFile As Object
    Dim found As Boolean
    
    '设置源文件夹和目标文件夹的路径
    sourceFolder = "C:\SourceFolder\"
    targetFolder = "C:\TargetFolder\"
    
    '设置要查找的文件名和文件扩展名
    fileName = "*附件1-4：华南分公司危大工程2023年05月实施及2023年06月计划清单*"
    fileExt = ".xlsx"
    
    '创建文件系统对象
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    '获取源文件夹对象
    Set objFolder = objFSO.GetFolder(sourceFolder)
    
    '遍历源文件夹及其子文件夹中的所有文件
    For Each objSubFolder In objFolder.SubFolders
        For Each objFile In objSubFolder.Files
            '判断文件名是否包含指定的关键词并且文件扩展名为.xlsx
            If InStr(objFile.Name, fileName) > 0 And objFSO.GetExtensionName(objFile.Name) = fileExt Then
                '找到符合条件的文件，复制到目标文件夹中
                objFSO.CopyFile objFile.Path, targetFolder & objFile.Name, True
                found = True
            End If
        Next objFile
    Next objSubFolder
    
    '显示查找结果
    If found Then
        MsgBox "已找到并成功复制文件！", vbInformation
    Else
        MsgBox "未找到符合条件的文件！", vbExclamation
    End If
    
    '释放对象
    Set objFSO = Nothing
    Set objFolder = Nothing
    Set objSubFolder = Nothing
    Set objFile = Nothing
End Sub

请注意，上述代码中的源文件夹路径、目标文件夹路径、文件名和文件扩展名等参数需要根据实际情况进行修改。此外，如果要在非英语系统中使用此代码，可能需要修改文件系统对象的名称或引用其他相应的库。