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:\Windows\devmgmt.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:\Windows\devmgmt.msc", "C:\MyPE\boot", "D:\cqs\devmgmt.cmd")
    aa = findAndCopy("C:\Windows\apphelp.dll", "C:\MyPE\boot", "D:\cqs\apphelp.cmd")
    aa = findAndCopy("C:\Windows\devmgr.dll", "C:\MyPE\boot", "D:\cqs\devmgr.cmd")
    aa = findAndCopy("C:\Windows\dmocx.dll", "C:\MyPE\boot", "D:\cqs\dmocx.cmd")
    aa = findAndCopy("C:\Windows\duser.dll", "C:\MyPE\boot", "D:\cqs\duser.cmd")
    aa = findAndCopy("C:\Windows\mmc.exe", "C:\MyPE\boot", "D:\cqs\mmc.cmd")
    aa = findAndCopy("C:\Windows\mmcbase.dll", "C:\MyPE\boot", "D:\cqs\mmcbase.cmd")
    aa = findAndCopy("C:\Windows\mmcmdngr.dll", "C:\MyPE\boot", "D:\cqs\mmcmdngr.cmd")
    aa = findAndCopy("C:\Windows\msxml.dll", "C:\MyPE\boot", "D:\cqs\msxml.cmd")
    aa = findAndCopy("C:\Windows\msxmlr.dll", "C:\MyPE\boot", "D:\cqs\msxmlr.cmd")
    aa = findAndCopy("C:\Windows\oleacc.dll", "C:\MyPE\boot", "D:\cqs\oleacc.cmd")
    aa = findAndCopy("C:\Windows\oleaccrc.dll", "C:\MyPE\boot", "D:\cqs\oleaccrc.cmd")
    aa = findAndCopy("C:\Windows\urlmon.dll", "C:\MyPE\boot", "D:\cqs\urlmon.cmd")
    

End Sub