批处理之家 - Powered by Discuz! Board

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

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

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 时间: 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再加上大小写判断会保险一点。
试试这样看：

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

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 时间: 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

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

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 时间: 2012-12-24 16:03

回复 11# apang

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

欢迎光临批处理之家 (http://bbs.bathome.net/)