Vbscript - 檢查每個子文件夾的文件和複製文件

Question

我試圖讓這個腳本工作。 它基本上應該鏡像兩組文件夾，並確保它們完全相同。如果文件夾丟失，應複製文件夾及其內容。

然後，腳本應該比較DateModified屬性，並且只在源文件比目標文件新時才複製文件。

我想在一起做一個腳本，完全是。到目前爲止，我已經能夠檢查所有子文件夾，如果它們存在，然後創建它們，如果它們不存在。 然後，我已經能夠掃描頂級源文件夾中的文件，並將它們複製（如果它們不存在或者如果DateModified屬性在源文件上更新）。

剩下的是基本上掃描每個子文件夾的文件，並複製它們，如果它們不存在或如果DateModified郵票是新的。

下面的代碼：

Dim strSourceFolder, strDestFolder 

strSourceFolder = "c:\users\vegsan\desktop\Source\" 
strDestFolder = "c:\users\vegsan\desktop\Dest\" 

Set fso = CreateObject("Scripting.FileSystemObject") 
Set objTopFolder = fso.GetFolder(strSourceFolder) 
Set colTopFiles = objTopFolder.Files 

'Check to see if subfolders actually exist. Create if they don't 
Set objColFolders = objTopFolder.SubFolders 
For Each subFolder in objColFolders 
    CheckFolder subFolder, strSourceFolder, strDestFolder 
Next 

' Check all files in first top folder 
For Each objFile in colTopFiles 
    CheckFiles objFile, strSourceFolder, strDestFolder 
Next 

Sub CheckFolder (strSubFolder, strSourceFolder, strDestFolder) 
    Set fso = CreateObject("Scripting.FileSystemObject") 

    Dim folderName, aSplit 

    aSplit = Split (strSubFolder, "\") 
    UBound (aSplit) 

    If UBound (aSplit) > 1 Then 
     folderName = aSplit(UBound(aSplit)) 
     folderName = strDestFolder & folderName 
    End if 

    If Not fso.FolderExists(folderName) Then 
     fso.CreateFolder(folderName) 
    End if 

End Sub 

Sub CheckFiles (file, SourceFolder, DestFolder) 

    Set fso = CreateObject("Scripting.FileSystemObject") 
     Dim DateModified 
     DateModified = file.DateLastModified 
     ReplaceIfNewer file, DateMofidied, SourceFolder, DestFolder 
End Sub 


Sub ReplaceIfNewer (sourceFile, DateModified, SourceFolder, DestFolder) 

    Const OVERWRITE_EXISTING = True 
    Dim fso, objFolder, colFiles, sourceFileName, destFileName 
    Dim DestDateModified, objDestFile 

    Set fso = CreateObject("Scripting.FileSystemObject") 

    sourceFileName = fso.GetFileName(sourceFile) 
    destFileName = DestFolder & sourceFileName 

    if Not fso.FileExists(destFileName) Then 
     fso.CopyFile sourceFile, destFileName 

    End if 

    if fso.FileExists(destFileName) Then 

     Set objDestFile = fso.GetFile(destFileName) 
     DestDateModified = objDestFile.DateLastModified 


     if DateModified <> DestDateModified Then 
      fso.CopyFile sourceFile, destFileName 
     End if 

    End if 

End Sub 

Answer 1

我知道這是一個老的文章，但我一直在尋找一種方式來運行VBS複製和修改，並運行基於最新的備份數據通過所有子目錄和文件而偶然發現基於上述問題的解決方案

您的代碼在該行的錯誤

ReplaceIfNewer file, DateMofidied, SourceFolder, DestFolder 

你DateModified誤拼寫導致此不通過你的文件.datelastmodified發送到你的子。除此之外，您的代碼在我修復該問題時正在複製第一級文件和文件夾。

我已經構建在此代碼上，通過再次調用sub中的子目錄來複制每個corespondng子目錄的多個子級目錄並複製文件，每次使用動態數組重命名源文件夾。

這組代碼將比較兩個文件，並用較新的版本替換舊版本。 見代碼：

Dim i 
Dim defaultchoice 
Dim Defaultuser 
Dim Theday 
Dim Source 
Dim driveletter 
Dim backup1 
Dim destin 
Dim objshell 
Dim objf 
Dim Bsplit 
Dim k 
Dim total 
Dim SourceFolder 
Dim DestFolder 
Dim objFSO 
Dim Objfolder 
Dim Msg1 


'********************************************************** 
' Start off your arrays at zero 
'********************************************************** 
i=0 


'********************************************************** 
'set default choice to 1 run with user input to select source and destination or 0 to follow below schedule 
'********************************************************** 
defaultchoice = 0 
Defaultuser = "*******" 


Set objFSO = CreateObject("Scripting.FileSystemObject") 

'********************************************************** 
' Define default locations where you get data and where you want to put it depending on the day, BAcking up something different every day in the week 
'********************************************************** 
Theday = weekday(now()) 

if Theday = 2 then 
    Source = "U:\**" 
    destin = "H:\**\Backups" 
elseif Theday = 4 then 
    Source ="C:\***\backups" 
    destin = "H:\***\Backups" 
elseif Theday = 3 then 
    Source ="U:\****" 
    destin = "H:\****\Backups" 
elseif Theday = 5 then 
    Source ="C:\Users\*****\Documents" 
    destin = "H:\*****\Backups" 
elseif Theday = 6 then 
    Source = "L:\******\data" 
    destin = "H:\******\Backups" 

else 
    Wscript.Quit 
end if 

if defaultchoice = 1 then 
    MSG1 = MsgBox("Do you wish to manually enter your location",vbyesno,"Select") 
    If MSG1 = vbyes then 
     Source = inputbox("Enter the file location you wish to get data from",,Source) 
     Destin = inputbox("Enter the file location you wish to Backup to",,destin) 
    else  
     Set objShell = CreateObject("Shell.Application") 
     Set objF = objShell.BrowseForFolder(0, "Choose folder to get data from", 0, 17) 
     checkfolderagain objf 
     source = objF.self.path 

     Destin = inputbox("Enter the file location you wish to Backup to",,destin) 
    end if 

end if 

'********************************************************** 
' Check to see if your source exists 
'********************************************************** 
If objFSO.FolderExists(Source) Then 
'********************************************************** 
' Create Destination folder if it doesn't exist 
'********************************************************** 

    BSplit = Split (destin, "\") 
    total = UBound (BSplit) 
    Backup1= Bsplit(i) 
    If objfso.FolderExists(Backup1) Then 
     For k= 1 to total 
     Backup1= Backup1 & "\" & Bsplit(k) 
     If objFSO.FolderExists (backup1) Then 
     Else 
      Set objFolder = objFSO.CreateFolder(backup1) 
     End If 
     next 
    else 
     Msgbox("Destination Drive does not exist") 
     Wscript.Quit 
    end if 

'********************************************************** 
' Format to utilize the Get folder command 
'********************************************************** 

    SourceFolder = source & "\" 
    DestFolder = destin & "\" 

'********************************************************** 
' Execute the Sub to write files and sub folders 
'********************************************************** 
    copyfirstfilesandsubs Sourcefolder, Destfolder  
else 
    Msgbox("Source folder does not exist") 
end if 

set i = nothing 
Set defaultchoice = nothing 
set Defaultuser = nothing 
Set Theday = nothing 
set Source = nothing 
set driveletter = nothing 
set backup1 = nothing 
set destin = nothing 
Set objshell = nothing 
Set objf = nothing 
Set Bsplit = nothing 
Set k = nothing 
Set total = nothing 
set objFSO = nothing 
set Objfolder = nothing 
Set Msg1 = nothing 

'********************************************************** 
' first copy each file in top directory then create each subfolder 
'********************************************************** 
Sub copyfirstfilesandsubs(strsourcefolder,strdestfolder) 

'********************************************************** 
' Get the files that are in source folder and define top folder 
'********************************************************** 
    Dim objColFolders 
    Dim colTopFiles 
    Dim objTopFolder 

    Set objTopFolder = objfso.GetFolder(strsourcefolder) 
    Set colTopFiles = objTopFolder.Files 

    For Each objFile in colTopFiles 
     CheckFiles objFile, strSourceFolder, strDestFolder 
    Next 

    Set objColFolders = objTopFolder.SubFolders 
    For Each subFolder in objColFolders 
     CheckFolder subFolder, strSourceFolder, strDestFolder 
    next 

    set objColFolders = nothing 
    Set colTopFiles = nothing 
    Set objTopFolder = nothing 
end sub 

'********************************************************** 
' looks at modified date and sends date to ReplaceIfNewer 
'********************************************************** 
Sub CheckFiles (file, CFSourceFolder, CFDestFolder) 

    Dim DateModified 
    DateModified = file.DateLastModified 
    ReplaceIfNewer file, DateModified, CFSourceFolder, CFDestFolder 
End Sub 

'********************************************************** 
'copys file if it doesn't exist or updates whichever version of the file is older or does nothing if they are equal 
'********************************************************** 
Sub ReplaceIfNewer (File, DateModified, CFSourceFolder, CFDestFolder) 
    Dim sourcefilename, destFileName, objDestFile, DestDateModified 

    Const OVERWRITEEXISTING = True 
    sourceFileName = objfso.GetFileName(File) 
    destFileName = CFDestFolder & sourceFileName 
    if objfso.FileExists(destFileName) Then 
     Set objDestFile = objfso.GetFile(destFileName) 
      DestDateModified = objDestFile.DateLastModified 
    if DateModified > DestDateModified Then 
       objfso.CopyFile File, destFileName, OVERWRITEEXISTING 
     elseif DateModified < DestDateModified Then 
       objfso.CopyFile destFileName, File, OVERWRITEEXISTING 
     End if 
    else 
     objfso.CopyFile File, destFileName 

    End if 
End Sub 

'********************************************************** 
'Creates folder if it currently doesn not exist, Creates new source folder path based on the folder it is in and repeats process at lower level. 
'********************************************************** 
Sub CheckFolder (SubFolder, cfoSourceFolder, cfoDestFolder) 

    Dim foldername 
    Dim asplit 
    Dim chkdestfolder 
    Dim SourceFolder2() 
    Dim DestFolder2() 

     aSplit = Split (SubFolder, "\") 
    UBound (aSplit) 
     If UBound (aSplit) > 1 Then 
     folderName = aSplit(UBound(aSplit))     

    End if 
    chkdestfolder = cfoDestFolder & folderName 
'********************************************************** 
'Identify any folders that you don't have permissions to copy from they will error out as you do not have permission to this folder 
'********************************************************** 
    if subfolder = "C:\Users\" & defaultuser & "\Documents\My Shapes" or subfolder="C:\Users\" & defaultuser & "\Documents\My Music" or subfolder="C:\Users\" & defaultuser & "\Documents\My Pictures"or subfolder="C:\Users\" & defaultuser & "\Documents\My Videos" then 
    else 
    If Not objfso.FolderExists(chkdestfolder) Then 
     objfso.CreateFolder(chkdestfolder) 
    End if 

    i=i+1 

'********************************************************** 
'Redefine Source folder and destination folder one level deeper  
'********************************************************** 
    ReDim Preserve SourceFolder2(i) 
    ReDim Preserve DestFolder2(i) 
    SourceFolder2(i) = cfoSourceFolder & foldername & "\" 
    DestFolder2(i) = chkdestfolder & "\" 

'********************************************************** 
'Execute the sub to write folders within the subfolder you just created 
'********************************************************** 
    copyfirstfilesandsubs SourceFolder2(i), DestFolder2(i) 
    end if 
    set foldername = nothing 
    set asplit = nothing 
    set chkdestfolder = nothing 
End Sub 

Sub checkfolderagain (objf) 
     If objF Is Nothing Then  
      Wscript.Quit 
     End If 
end sub 

Answer 2

我敢肯定，這個代碼是令人愉快的，但是同步兩個文件夾是一個普遍的問題，也有免費的實用工具包含在Windows，會做，所以你不需要編寫和維護這段代碼。 ROBOCOPY是一個開始的好地方。另請參閱XCOPY或諸如rsync的開源替代品。