'同步对比更新脚本
               'BY:心灵 QQ:27407749
      '欢迎QQ技术交流或者是同一个市的可以亲临现场指教
      '地址:清城区北苑新村新浪网吧(原世纪网吧)

Option Explicit

sub copyfol(sDir,Ddir)
 'sDiry要对比的文件夹，,Ddir要操作文件夹
   dim fso,fol,fs,f1, objfile
   dim arrFiles(),arrSize(),arrModified()
   dim i
   if right(ddir,1)<>"\" then ddir =ddir & "\"
   if right(sdir,1)<>"\" then sdir =sdir & "\"
   Set fso = CreateObject("Scripting.FileSystemObject")
   '判断文件是否存在
   if not (fso.FolderExists(sdir))  then
       msgbox "找不到文件夹：" & sdir
       exit sub
   end if
   if not (fso.FolderExists(ddir))  then
        msgbox "找不到文件夹：" & sdir
        exit sub
   end if
 
   '获得要操作的文件列表及相关信息并储存到数组
   set fol=fso.GetFolder(ddir)
   set fs=fol.files
   i=0
   redim arrFiles(fs.count-1)
   redim arrSize(fs.count-1)
   redim arrModified(fs.count-1)
   for each f1 in fs
      arrfiles(i)=f1.name
      arrSize(i)=f1.size
      arrModified(i)=f1.DateLastModified
      i=i+1
   next
   '把要操作的文件夹逐一根要对比的文件比较,不同则覆盖,多余就删除,没有就复制
   set fol=fso.GetFolder(sdir)
   set fs=fol.files
   for i = 0 to ubound(arrfiles)
       '文件存在则比较是否相同,否则删除

       dim delfile  '要操作类型,
       delfile=false
       for each f1 in fs
           if strcomp(arrfiles(i),f1.name,vbTextCompare)=0 then              
               if arrsize(i)<> f1.size or arrModified(i)<>f1.DateLastModified then
                  fso.copyfile f1.path, ddir & arrfiles(i),true       
               end if
               delfile=true '如果文件存在
               exit for
            end if
        next
        if not delfile then                  
            set objfile=fso.getfile(ddir &arrfiles(i))
            objfile.Delete (true)
         end if          
    next
   '如果对比目录sdir中有文件是要操作目录ddir中没有的,则复制到ddir
   for each f1 in fs
       delfile=false
       for i=0 to ubound(arrfiles)
          if strcomp(f1.name,arrfiles(i),vbtextcompare)=0 then
             delfile=true
             exit for
          end if
        next 
         if right (ddir,1)<>"\" then ddir=ddir &"\"
        if not delfile then          
           f1.copy ddir,true
        end if
   next
   '以下代码处理子文件夹  
   dim fols
   set fol=Fso.GetFolder(sdir)
   set fols=fol.SubFolders
   for each f1 in fols
      if not (fso.FolderExists(ddir & f1.name)) then 
         fso.CreateFolder(ddir & f1.name)
      end if
      copyfol sdir & f1.name ,ddir & f1.name
   next
end sub

   '以下是对比路径 第一个是远程路径 第二个是本地路径
copyfol "\\192.168.0.200\vbs\迅闪","C:\c\d"