CopyFilesAtCmd "E:\a", "D:\b"

Function CopyFilesAtCmd(ByVal strSouDir, ByVal strDesDir)
  CopyFilesAtCmd = CreateObject("WScript.Shell").Run("xcopy """ & strSouDir & _
    """ """ & strDesDir & """ /e /v /c /i /h /r /y /z", 0, True)
End Function
复制代码

CopyFiles "E:\a", "D:\b"

Function CopyFiles(ByVal strSouDir, ByVal strDesDir)
  Dim fso, arrList, oItem
  Set fso = CreateObject("Scripting.FileSystemObject")
  If Right(strSouDir,1) <> "\" Then strSouDir = strSouDir & "\"
  If Right(strDesDir,1) <> "\" Then strDesDir = strDesDir & "\"
  arrList = ScanFolder(strSouDir)
  For Each oItem In arrList
    If Right(oItem,1) <> "\" Then
      strFileName = fso.GetFile(oItem).Name
      strParentFolder = fso.GetFile(oItem).ParentFolder
      strSubPath = Right(strParentFolder, Len(strParentFolder)-Len(strSouDir))
      MD strDesDir & strSubPath
      fso.CopyFile oItem, strDesDir & strSubPath & "\" & strFileName, True
    End If
  Next
End Function

Function ScanFolder(ByVal strFolder)
  If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"
  Dim arrList() : ReDim Preserve arrList(0) : arrList(0) = strFolder
  Call DO_SCAN_FOLDER(arrList, strFolder) : ScanFolder = arrList
End Function
Function DO_SCAN_FOLDER(ByRef arrList, ByVal strFolder)
  On Error Resume Next
  Dim fso, objItems, objFile, objFolder
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set objItems = fso.GetFolder(strFolder)
  If (Not fso.FolderExists(strFolder)) Then Exit Function
  For Each objFile In objItems.Files
    ReDim Preserve arrList(UBound(arrList) + 1)
    arrList(UBound(arrList)) = objFile.Path
  Next
  For Each objFolder In objItems.subfolders
    ReDim Preserve arrList(UBound(arrList) + 1)
    arrList(UBound(arrList)) = objFolder.Path & "\"
    Call DO_SCAN_FOLDER(arrList, objFolder.Path & "\")
  Next
End Function

Sub MD(ByVal strPath)
  Set fso = CreateObject("Scripting.FileSystemObject")
  Dim arrPath, strTempPath, nSkip
  If Right(strPath, 1) = "\" Then strPath = Left(strPath, Len(strPath) - 1)
  arrPath = Split(strPath, "\")
  If Left(strPath, 2) = "\\" Then    ' UNC Path
    nSkip = 3
    strTempPath = arrPath(0) & "\" & arrPath(1) & "\" & arrPath(2)
  Else                              ' Local Path
    nSkip = 1
    strTempPath = arrPath(0)
  End If
  For i = nSkip To UBound(arrPath)
    strTempPath = strTempPath & "\" & arrPath(i)
    If Not fso.FolderExists(strTempPath) Then fso.CreateFolder strTempPath
  Next
  Set fso = Nothing
End Sub
复制代码