我知道这是一篇旧帖子，但我一直在寻找一种方法来运行 VBS 以根据修改日期复制和备份数据并遍历所有子目录和文件，并偶然发现了基于上述问题的解决方案
您的代码在该行中有错误
ReplaceIfNewer file, DateMofidied, SourceFolder, DestFolder
你有 DateModified 拼写错误导致这不能通过你的 file.datelastmodified 发送到你的子。除此之外，您的代码在我修复后复制了第一级文件和文件夹。
我已经在此代码的基础上构建了复制多个级别的子目录并复制每个 corespondng 子目录中的文件，方法是在其自身内部再次调用 sub，每次使用动态数组重命名源文件夹。
这组代码将比较这两个文件并将旧的替换为新的。见代码：
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