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 拼写错误，导致该行无法通过您的 file.datelastmodified 发送到您的子系统。除此之外，一旦我修复了它，您的代码就会复制第一层文件和文件夹。

我在此代码的基础上构建了复制多个级别的子目录，并通过每次使用动态数组在其内部再次调用子目录来复制每个 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。