文件夹同步工具源码

Option Explicit
'操作说明
'第一步，指定同步的源文件夹
'第二步，指定一个用于映射网络驱动器的盘符
'第三步，指定本地目标文件夹
'第四步，确认开始操作
Dim objNetwork, strDrive, objShell, objUNC, Fs
Dim strRemotePath, strDriveLetter, strNewName
'
strRemotePath = InputBox("请输入远程源文件夹的路径:", "文件同步工具", "\\tp022\help")
strDriveLetter = InputBox("把"&strRemotePath&"映射为本地的驱动器名:", "文件同步工具", "W:")
 
strNewName = "网络硬盘"

Set Fs=WScript.CreateObject("Scripting.FileSystemObject")
Set objNetwork = WScript.CreateObject("WScript.Network")

if not Fs.DriveExists(left(strDriveLetter,1)) then

  ' Section to map the network drive
  objNetwork.MapNetworkDrive strDriveLetter, strRemotePath
  ' Section which actually (re)names the Mapped Drive
  Set objShell = WScript.CreateObject("Shell.Application")
  objShell.NameSpace(strDriveLetter).Self.Name = strNewName
 
end if

On Error Resume Next
Dim DirTotal, TimeSpend, FileTotal, fso, curPath, sPath, objFolder, objFolderItem, strPath

Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0
Const OPTIONS = 0

Set objShell = WScript.CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(MY_COMPUTER)
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path

Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "指定本地同步文件夹:", OPTIONS, strPath)
If objFolder Is Nothing Then
         MsgBox "您没有选择任何有效目录!"
         WScript.Quit
Else
         Set objFolderItem = objFolder.Self
         sPath = objFolderItem.Path
         curPath = sPath
         FileTotal = 0       
         DirTotal = 0        
         if MsgBox ("确认现在开始同步吗？本地目录：" & curPath & " 远程目录： " & strRemotePath, 4, "文件同步工具") = 7 THEN 
          Set fso = Nothing       
          WScript.Quit         
         end if       
        
         TimeSpend = Timer
         myFind strDriveLetter,curPath
         Set fso = Nothing
   objNetwork.RemoveNetWorkDrive strDriveLetter,true,true
         TimeSpend = Round(Timer - TimeSpend, 2)
         MsgBox "处理完成！共耗费时间：" & TimeSpend & " 处理文件数： " & FileTotal
   WScript.Quit
End If

Sub myFind(ByVal thePath, ByVal trgPath)
         Dim fso, trg, myFolder, myFile, trgFile, curFolder, trgFolder, curFolders
         Set fso = WScript.CreateObject("Scripting.FileSystemObject")
         Set trg = WScript.CreateObject("Scripting.FileSystemObject")
         Set curFolders = fso.getfolder(thePath)
         set trgFolder =trg.getfolder(trgPath)
        
         DirTotal = DirTotal + 1       
         If curFolders.Files.Count > 0 Then
                 For Each myFile In curFolders.Files
                         if not trg.FileExists(myFile.Name) then
                          myFile.Copy FormatPath(trgPath) & "\" & myFile.Name
                         else
                          trgFile=trg.GetFile(myFile.Name)
        if ((myFile.Size<>trgFile.Size) OR (myFile.DateCreated<>trgFile.DateCreated) OR (myFile.DateLastModified<>trgFile.DateLastModified)) THEN
         myFile.copy FormatPath(trgPath) & "\" & myFile.Name, true
        end if
       end if
       FileTotal = FileTotal + 1
                 Next
         End If
         If curFolders.subfolders.Count > 0 Then
                 For Each myFolder In curFolders.subfolders
                   if not trg.FolderExists(FormatPath(trgPath) & "\" & myFolder.Name) THEN
                    trg.CreateFolder  FormatPath(trgPath) & "\" & myFolder.Name
                   end if
                         myFind FormatPath(thePath) & "\" & myFolder.Name, FormatPath(trgPath) & "\" & myFolder.Name
                 Next
         End If
End Sub

Function FormatPath(ByVal thePath)
         thePath = Trim(thePath)
         FormatPath = thePath
         If Right(thePath, 1) = "\" Then FormatPath = Mid(thePath, 1, Len(thePath) - 1)
End Function


将以上代码另存为文件名为：syncfiles.vbs 就可以运行使用了