Board logo

标题: [问题求助] 帮忙改VBS代码-比较两个文件夹,拷贝不同到文件到指定位置 [打印本页]

作者: ww0000    时间: 2012-12-15 13:30     标题: 帮忙改VBS代码-比较两个文件夹,拷贝不同到文件到指定位置

  1. Dim fso, File
  2.     Dim PathA, PathB
  3.     Dim FilesInPathA
  4.     Set fso = CreateObject("Scripting.FileSystemObject")
  5.     Set PathA = fso.GetFolder("C:\A")  '获得路径A下的文件列表
  6.     For Each File In PathA.Files
  7.         FilesInPathA = FilesInPathA & "|" & File.Name
  8.     Next
  9.     Set PathB = fso.GetFolder("C:\B")  '获得路径B下的文件列表
  10.     For Each File In PathB.Files
  11.     If InStr(FilesInPathA, File.Name)=0 Then '判断此文件在路径A下是否存在
  12.     File.Delete false '如果不存在则删除
  13.         End If
  14.     Next
  15.     Set fso = Nothing
复制代码
以上代码是用于比较两个文件夹,删除“B文件夹”中与“A文件夹”中不同的文件,我现在要将删除功能改为拷贝功能,也就是说,将“B文件夹”中有,而A“文件夹”中没有的文件拷贝到“C文件夹”,怎么改?谢谢
作者: ww0000    时间: 2012-12-15 15:58

这样为什么不行呢?


Dim fso, File
    Dim PathA, PathB
    Dim FilesInPathA
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set PathA = fso.GetFolder("C:\Documents and Settings\Administrator\桌面\VBS删除文件\1")  '获得路径A下的文件列表
    For Each File In PathA.Files
        FilesInPathA = FilesInPathA & "|" & File.Name
    Next
    Set PathB = fso.GetFolder("C:\Documents and Settings\Administrator\桌面\VBS删除文件\2")  '获得路径B下的文件列表
    For Each File In PathB.Files
    If InStr(FilesInPathA, File.Name)=False Then '判断此文件在路径A下是否存在
    File.copy PathA '如果不存在则拷贝
        End If
    Next
    Set fso = Nothing
作者: apang    时间: 2012-12-15 16:46

回复 2# ww0000

没有找到的话,InStr返回的是0而不是false。InStr再加上大小写判断会保险一点。
试试这样看:
  1. Dim PathA,PathB,PathC,FSO,File
  2. PathA = "c:\A"
  3. PathB = "c:\B"
  4. PathC = "c:\C"
  5. Set FSO = CreateObject("Scripting.FileSystemObject")
  6. If Not FSO.FolderExists(PathC) Then FSO.CreateFolder(PathC)
  7. For Each File In FSO.GetFolder(PathB).Files
  8.    If Not FSO.FileExists(PathA &"\" & File.Name) Then
  9.       File.Copy PathC &"\"
  10.    End If
  11. Next
  12. MsgBox "OK"
复制代码

作者: ww0000    时间: 2012-12-15 17:16

回复 3# apang


    多谢了,我是新手,请多指教!!
作者: ww0000    时间: 2012-12-21 19:27

回复 3# apang


    老师,如果要历遍子文件夹,这个脚本应该如何改呢?
谢谢!
作者: czjt1234    时间: 2012-12-22 14:18

遍历子文件夹,FSO好象没这个功能

调用批处理命令dir /a:d/s/b
  1. set objWsh = CreateObject("Wscript.Shell")
  2. Set objExec = objwsh.Exec("cmd.exe /c dir /a:d/s/b d:\1")
  3. Do Until objExec.StdOut.AtEndOfStream
  4.     Call xcopy(objExec.StdOut.ReadLine)
  5. Loop
  6. Sub xcopy(pathB)
  7.     If pathB = "" Then Exit Sub
  8.     Dim PathA, PathC, FSO, File
  9.     PathA = "c:\A"
  10.     PathC = "c:\C"
  11.     Set FSO = CreateObject("Scripting.FileSystemObject")
  12.     If Not FSO.FolderExists(PathC) Then FSO.CreateFolder(PathC)
  13.     For Each File In FSO.GetFolder(PathB).Files
  14.        If Not FSO.FileExists(PathA &"\" & File.Name) Then
  15.           File.Copy PathC &"\"
  16.        End If
  17.     Next
  18.     MsgBox pathB & " OK"
  19. End Sub
复制代码
其实可以直接用批处理命令xcopy
作者: ww0000    时间: 2012-12-22 14:52

回复 6# czjt1234
老师,以下是对比文件夹A和B,将B文件夹中有、而A文件夹中没有的文件,拷贝到C文件夹!你给的不能实现此功能!
Dim PathA,PathB,PathC,FSO,File
PathA = "c:\A"
PathB = "c:\B"
PathC = "c:\C"
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists(PathC) Then FSO.CreateFolder(PathC)
For Each File In FSO.GetFolder(PathB).Files
   If Not FSO.FileExists(PathA &"\" & File.Name) Then
      File.Copy PathC &"\"
   End If
Next
MsgBox "OK"
作者: ww0000    时间: 2012-12-22 19:38

回复 6# czjt1234


    老师的这个好像没有B文件夹吧?怎么对比?
另外:d:\1是什么意思?
作者: czjt1234    时间: 2012-12-22 20:01

哦,d:\1是我测试时用的,忘记改了

你把 d:\1 改成  C:\B
作者: ww0000    时间: 2012-12-23 15:18

回复 9# czjt1234


    老师你测试过了吗?
我测试在D:\B 只能拷贝里面子文件夹的文件,其他文件不能拷贝,在包含中文字符的文件夹执行没反应!!
作者: apang    时间: 2012-12-23 21:05

整的好复杂,不知道有没有简单方法。。。
  1. PathA = "c:\A"
  2. PathB = "c:\B"
  3. PathC = "c:\C"
  4. Dim Str
  5. Set Ws = CreateObject("WScript.Shell")
  6. Set FSO = CreateObject("Scripting.FileSystemObject")
  7. Str = GetFileStr(PathA)
  8. XcopyFile PathB
  9. MsgBox "OK"
  10. Sub XcopyFile(SubPath)
  11.    For Each File In FSO.GetFolder(SubPath).Files
  12.       Name = "|" & File.Name & "|"
  13.       If InStr(LCase(Str),LCase(Name)) = 0 Then
  14.          Name = PathC & Right(File.Path,Len(File.Path) - Len(PathB))
  15.          Ws.Run "xcopy " & chr(34) & File.Path & chr(34) & " " &_
  16.          chr(34) & Left(Name,InStrRev(Name,"\")) & chr(34) & " /s",0
  17.       End If
  18.    Next
  19.    For Each Folder In FSO.GetFolder(SubPath).SubFolders
  20.       XcopyFile Folder.Path
  21.    Next
  22. End Sub
  23. Function GetFileStr(SubPath)
  24.    For Each File In FSO.GetFolder(SubPath).Files
  25.       Str = Str & File.Name & "|"
  26.    Next
  27.    For Each Folder In FSO.GetFolder(SubPath).SubFolders
  28.       GetFileStr Folder.Path
  29.    Next
  30.    GetFileStr = "|" & Str
  31. End Function
复制代码

作者: ww0000    时间: 2012-12-24 16:03

回复 11# apang


    老师,您太厉害了!!!非常感谢您的帮助,问题完全解决!!谢谢!!





欢迎光临 批处理之家 (http://www.bathome.net/) Powered by Discuz! 7.2