[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

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

本帖最后由 逆流而上的熊猫 于 2015-7-31 16:01 编辑

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

评分人数

    • Batcher: 感谢给帖子标题标注[已解决]字样PB + 2

要求覆盖所有文件?不如先删除目标文件夹,再执行复制文件夹操作。
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

回复 2# yu2n


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

TOP

方法一:调用 xcopy
  1. CopyFilesAtCmd "E:\a", "D:\b"
  2. Function CopyFilesAtCmd(ByVal strSouDir, ByVal strDesDir)
  3.   CopyFilesAtCmd = CreateObject("WScript.Shell").Run("xcopy """ & strSouDir & _
  4.     """ """ & strDesDir & """ /e /v /c /i /h /r /y /z", 0, True)
  5. End Function
复制代码
方法二:纯VBS
  1. CopyFiles "E:\a", "D:\b"
  2. Function CopyFiles(ByVal strSouDir, ByVal strDesDir)
  3.   Dim fso, arrList, oItem
  4.   Set fso = CreateObject("Scripting.FileSystemObject")
  5.   If Right(strSouDir,1) <> "\" Then strSouDir = strSouDir & "\"
  6.   If Right(strDesDir,1) <> "\" Then strDesDir = strDesDir & "\"
  7.   arrList = ScanFolder(strSouDir)
  8.   For Each oItem In arrList
  9.     If Right(oItem,1) <> "\" Then
  10.       strFileName = fso.GetFile(oItem).Name
  11.       strParentFolder = fso.GetFile(oItem).ParentFolder
  12.       strSubPath = Right(strParentFolder, Len(strParentFolder)-Len(strSouDir))
  13.       MD strDesDir & strSubPath
  14.       fso.CopyFile oItem, strDesDir & strSubPath & "\" & strFileName, True
  15.     End If
  16.   Next
  17. End Function
  18. Function ScanFolder(ByVal strFolder)
  19.   If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"
  20.   Dim arrList() : ReDim Preserve arrList(0) : arrList(0) = strFolder
  21.   Call DO_SCAN_FOLDER(arrList, strFolder) : ScanFolder = arrList
  22. End Function
  23. Function DO_SCAN_FOLDER(ByRef arrList, ByVal strFolder)
  24.   On Error Resume Next
  25.   Dim fso, objItems, objFile, objFolder
  26.   Set fso = CreateObject("Scripting.FileSystemObject")
  27.   Set objItems = fso.GetFolder(strFolder)
  28.   If (Not fso.FolderExists(strFolder)) Then Exit Function
  29.   For Each objFile In objItems.Files
  30.     ReDim Preserve arrList(UBound(arrList) + 1)
  31.     arrList(UBound(arrList)) = objFile.Path
  32.   Next
  33.   For Each objFolder In objItems.subfolders
  34.     ReDim Preserve arrList(UBound(arrList) + 1)
  35.     arrList(UBound(arrList)) = objFolder.Path & "\"
  36.     Call DO_SCAN_FOLDER(arrList, objFolder.Path & "\")
  37.   Next
  38. End Function
  39. Sub MD(ByVal strPath)
  40.   Set fso = CreateObject("Scripting.FileSystemObject")
  41.   Dim arrPath, strTempPath, nSkip
  42.   If Right(strPath, 1) = "\" Then strPath = Left(strPath, Len(strPath) - 1)
  43.   arrPath = Split(strPath, "\")
  44.   If Left(strPath, 2) = "\\" Then    ' UNC Path
  45.     nSkip = 3
  46.     strTempPath = arrPath(0) & "\" & arrPath(1) & "\" & arrPath(2)
  47.   Else                              ' Local Path
  48.     nSkip = 1
  49.     strTempPath = arrPath(0)
  50.   End If
  51.   For i = nSkip To UBound(arrPath)
  52.     strTempPath = strTempPath & "\" & arrPath(i)
  53.     If Not fso.FolderExists(strTempPath) Then fso.CreateFolder strTempPath
  54.   Next
  55.   Set fso = Nothing
  56. End Sub
复制代码
1

评分人数

『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

返回列表