VBA批量查找和复制文件

Function findAndCopy(srcFile As String, destFile As String, cmdFile As String)
    Dim WSH As Object, wExec As Object, result
    Dim val, n
    Dim i As Integer
    Dim sFile As Object, Fso As Object
    Dim cmdStr As String
    
    
    Set WSH = CreateObject("WScript.Shell")
    ChDir ThisWorkbook.Path
    'Set wExec = WSH.exec("cmd.exe /c dir /b /s C:Windowsdevmgmt.msc")
    Set wExec = WSH.exec("cmd.exe /c dir /b /s " & srcFile)
    result = wExec.StdOut.ReadAll
    'ActiveSheet.Cells(1, 1) = result
    val = Split(result, Chr(13))
    'ActiveSheet.Cells(1, 2) = val(1)
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set sFile = Fso.CreateTextFile(cmdFile, True)
    
    i = 0
    For n = LBound(val) To UBound(val)
        If n < UBound(val) Then
            'ActiveSheet.Cells(1, i + 2) = val(i)
            cmdStr = "echo F | xcopy " & val(i) & " " & Replace(val(i), "C:", destFile) & " /Y /H"
            sFile.WriteLine (Replace(cmdStr, Chr(10), ""))
            i = i + 1
        End If
    Next
    sFile.WriteLine ("pause")
End Function

Sub main()
    Dim aa
    aa = findAndCopy("C:Windowsdevmgmt.msc", "C:MyPEoot", "D:cqsdevmgmt.cmd")
    aa = findAndCopy("C:Windowsapphelp.dll", "C:MyPEoot", "D:cqsapphelp.cmd")
    aa = findAndCopy("C:Windowsdevmgr.dll", "C:MyPEoot", "D:cqsdevmgr.cmd")
    aa = findAndCopy("C:Windowsdmocx.dll", "C:MyPEoot", "D:cqsdmocx.cmd")
    aa = findAndCopy("C:Windowsduser.dll", "C:MyPEoot", "D:cqsduser.cmd")
    aa = findAndCopy("C:Windowsmmc.exe", "C:MyPEoot", "D:cqsmmc.cmd")
    aa = findAndCopy("C:Windowsmmcbase.dll", "C:MyPEoot", "D:cqsmmcbase.cmd")
    aa = findAndCopy("C:Windowsmmcmdngr.dll", "C:MyPEoot", "D:cqsmmcmdngr.cmd")
    aa = findAndCopy("C:Windowsmsxml.dll", "C:MyPEoot", "D:cqsmsxml.cmd")
    aa = findAndCopy("C:Windowsmsxmlr.dll", "C:MyPEoot", "D:cqsmsxmlr.cmd")
    aa = findAndCopy("C:Windowsoleacc.dll", "C:MyPEoot", "D:cqsoleacc.cmd")
    aa = findAndCopy("C:Windowsoleaccrc.dll", "C:MyPEoot", "D:cqsoleaccrc.cmd")
    aa = findAndCopy("C:Windowsurlmon.dll", "C:MyPEoot", "D:cqsurlmon.cmd")
    

End Sub