[问题求助] 帮忙改VBS代码-比较两个文件夹，拷贝不同到文件到指定位置

ww0000

Dim fso, File 
    Dim PathA, PathB 
    Dim FilesInPathA 
    Set fso = CreateObject("Scripting.FileSystemObject") 
    Set PathA = fso.GetFolder("C:\A")  '获得路径A下的文件列表
    For Each File In PathA.Files 
        FilesInPathA = FilesInPathA & "|" & File.Name 
    Next
    Set PathB = fso.GetFolder("C:\B")  '获得路径B下的文件列表
    For Each File In PathB.Files 
    If InStr(FilesInPathA, File.Name)=0 Then '判断此文件在路径A下是否存在 
    File.Delete false '如果不存在则删除 
        End If
    Next
    Set fso = Nothing
复制代码

以上代码是用于比较两个文件夹，删除“B文件夹”中与“A文件夹”中不同的文件，我现在要将删除功能改为拷贝功能，也就是说，将“B文件夹”中有，而A“文件夹”中没有的文件拷贝到“C文件夹”，怎么改？谢谢

ww0000

这样为什么不行呢？


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

回复 2# ww0000

没有找到的话，InStr返回的是0而不是false。InStr再加上大小写判断会保险一点。
试试这样看：

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

回复 3# apang


    多谢了，我是新手，请多指教！！

ww0000

回复 3# apang


    老师，如果要历遍子文件夹，这个脚本应该如何改呢？
谢谢！

czjt1234

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

调用批处理命令dir /a:d/s/b

set objWsh = CreateObject("Wscript.Shell")
Set objExec = objwsh.Exec("cmd.exe /c dir /a:d/s/b d:\1")
Do Until objExec.StdOut.AtEndOfStream
    Call xcopy(objExec.StdOut.ReadLine)
Loop

Sub xcopy(pathB)
    If pathB = "" Then Exit Sub
    Dim PathA, PathC, FSO, File
    PathA = "c:\A"
    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 pathB & " OK"
End Sub
复制代码

其实可以直接用批处理命令xcopy

ww0000

回复 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

回复 6# czjt1234


    老师的这个好像没有B文件夹吧？怎么对比？
另外：d:\1是什么意思？

czjt1234

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

你把 d:\1 改成  C:\B

ww0000

回复 9# czjt1234


    老师你测试过了吗?
我测试在D:\B 只能拷贝里面子文件夹的文件,其他文件不能拷贝,在包含中文字符的文件夹执行没反应!!

apang

整的好复杂，不知道有没有简单方法。。。

PathA = "c:\A"
PathB = "c:\B"
PathC = "c:\C"
Dim Str
Set Ws = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Str = GetFileStr(PathA)
XcopyFile PathB
MsgBox "OK"

Sub XcopyFile(SubPath)
   For Each File In FSO.GetFolder(SubPath).Files
      Name = "|" & File.Name & "|"
      If InStr(LCase(Str),LCase(Name)) = 0 Then
         Name = PathC & Right(File.Path,Len(File.Path) - Len(PathB))
         Ws.Run "xcopy " & chr(34) & File.Path & chr(34) & " " &_
         chr(34) & Left(Name,InStrRev(Name,"\")) & chr(34) & " /s",0
      End If
   Next
   For Each Folder In FSO.GetFolder(SubPath).SubFolders
      XcopyFile Folder.Path
   Next
End Sub

Function GetFileStr(SubPath)
   For Each File In FSO.GetFolder(SubPath).Files
      Str = Str & File.Name & "|"
   Next
   For Each Folder In FSO.GetFolder(SubPath).SubFolders
      GetFileStr Folder.Path
   Next
   GetFileStr = "|" & Str
End Function
复制代码

ww0000

回复 11# apang


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