[问题求助] 【已解决】求个vbs的复制并且覆盖文件代码

逆流而上的熊猫

比如要把e盘a文件夹下的所有文件全部复制并覆盖到d散b文件夹下。应该怎么写。我写的不会覆盖已存在的同名称文件

yu2n

要求覆盖所有文件？不如先删除目标文件夹，再执行复制文件夹操作。

逆流而上的熊猫

回复 2# yu2n


    因为不是所有文件每次都复制，我只复制其中的一部分，要都删了 那其他文件就没了啊

yu2n

方法一：调用 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 FunctionCOPY

方法二：纯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 SubCOPY