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