方法一:调用 xcopy- 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
复制代码 方法二:纯VBS- 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
复制代码
|