VBS获取指定目录下最新文件拷贝然后以当前日期命名
近期有个需求，想对数据的备份目录中数据再次远程拷贝到计算机上，所以我们就通过vbs脚本将备份目录下的最新文件拷贝到指定目录，然后以当前的系统日期命名，总结为下：
我们在D盘下的data目录下有系统的备份文件，然后以日期命名，我们想通过获取文件的最后 一次修改时间进行获取最新文件，然后进行拷贝
然后拷贝到指定目录中，我们也可以拷贝到远程计算机
我们在本地进行测试，在D盘下的databackup中即可
代码送上：
sourcefilespath="D:\data"
'desfilepath="\\x.x.x.x\Backup\DataBackup"&""&Year(date)&-Month(date)&-Day(date)&" "&Hour(time)&-Minute(time)&"\"
desfilepath="D:\dbbackup\"&""&Year(date)&-Month(date)&-Day(date)&" "&Hour(time)&-Minute(time)&"\"
Set dic=CreateObject("Scripting.Dictionary")
Set fso=CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(desfilepath) Then
fso.CreateFolder desfilepath
End If
backFolderPath=GetLastModify(sourcefilespath)
fso.CopyFile backFolderPath,desfilepath&fso.GetFileName(backFolderPath)
msgbox "Finish"
''移动文件
Function MoveFiles(yPath,sPath)
On Error Resume Next
Dim folder,Files,File,subFolder,subFolders
Set fso = createobject("scripting.FileSystemObject")
Set Folder = fso.getFolder(yPath)
Set Files = Folder.Files
'msgbox yPath & sPaht
For Each File In Files
fso.MoveFile File,sPath&"\"
'msgbox File
Next
Set subFolder = Folder.SubFolders
For Each subFolders In subFolder
folderTemp = Split(subFolders,"\")
FolderName=FolderTemp(ubound(folderTemp))
fso.createFolder(sPath&"\"&FolderName)
MoveFiles subFolders,sPath&"\"&FolderName&"\"
fso.DeleteFolder subFolders
Next
End Function
Function GetLastModify(folder)
Set fso = createobject("scripting.FileSystemObject")
Set Folder=fso.getFolder(folder)
Set subFolders = Folder.Files
nowdate= Now
For Each subFolder In subFolders
dic.Add datediff("s",subFolder.DateLastModified,nowdate),subFolder.path
Next
NumArray=dic.Keys
bn = NumArray(0)
For Each nn In NumArray
If bn >= nn Then
bn = nn
End If
Next
GetLastModify = dic.Item(bn)
End Function
Function fSortArray(aSortThisArray)
Dim oArrayList, iElement
Set oArrayList = CreateObject( "System.Collections.ArrayList" )
For iElement = 0 To UBound(aSortThisArray)
oArrayList.Add aSortThisArray(iElement)
Next
oArrayList.Sort
set fSortArray = oArrayList
End Function
''拷贝文件
Function CopyFiles(yPath,sPath)
On Error Resume Next
Dim folder,Files,File,subFolder,subFolders
Set fso = createobject("scripting.FileSystemObject")
Set Folder = fso.getFolder(yPath)
Set Files = Folder.Files
'msgbox yPath & sPaht
For Each File In Files
fso.copyFile File,sPath&"\"
'msgbox File
Next
Set subFolder = Folder.SubFolders
For Each subFolders In subFolder
folderTemp = Split(subFolders,"\")
FolderName=FolderTemp(ubound(folderTemp))
fso.createFolder(sPath&"\"&FolderName)
CopyFiles subFolders,sPath&"\"&FolderName&"\"
'fso.DeleteFolder subFolders
Next
End Function
我们执行脚本后，发现以日期命名，然后将最新的数据拷贝到了这个文件夹路劲下
如果一个脚本想实现不同目录的数据拷贝的话，我们也可以通过以下方式写，我们有两种，第一种不正规的写法
sourcefilespath="D:\test"'desfilepath="\\10.12.0.51\Backup\DataBackup"&""&Year(date)&-Month(date)&-Day(date)&""&Hour(time)&-Minute(time)&"\"desfilepath="e:\data1\"&""&Year(date)&-Month(date)&-Day(date)&""&Hour(time)&-Minute(time)&"\"Set dic=CreateObject("Scripting.Dictionary")Set fso=CreateObject("Scripting.FileSystemObject")If Not fso.FolderExists(desfilepath) Thenfso.CreateFolder desfilepath End If backFolderPath=GetLastModify(sourcefilespath)fso.CopyFilebackFolderPath,desfilepath&fso.GetFileName(backFolderPath)msgbox "Finish" sourcefilespath2="D:\test2"'desfilepath="\\10.12.0.51\Backup\DataBackup"&""&Year(date)&-Month(date)&-Day(date)&""&Hour(time)&-Minute(time)&"\"desfilepath2="e:\data2\"&""&Year(date)&-Month(date)&-Day(date)&""&Hour(time)&-Minute(time)&"\"Set dic=CreateObject("Scripting.Dictionary")Set fso=CreateObject("Scripting.FileSystemObject")If Not fso.FolderExists(desfilepath2) Thenfso.CreateFolder desfilepath2 End If backFolderPath=GetLastModify(sourcefilespath2)fso.CopyFilebackFolderPath,desfilepath2&fso.GetFileName(backFolderPath)msgbox "Finish" ''移动文件Function MoveFiles(yPath,sPath)On Error Resume NextDim folder,Files,File,subFolder,subFoldersSet fso =createobject("scripting.FileSystemObject")Set Folder = fso.getFolder(yPath)Set Files = Folder.Files'msgbox yPath & sPahtFor Each File In Filesfso.MoveFile File,sPath&"\"'msgbox FileNextSet subFolder = Folder.SubFoldersFor Each subFolders In subFolderfolderTemp = Split(subFolders,"\")FolderName=FolderTemp(ubound(folderTemp))fso.createFolder(sPath&"\"&FolderName)MoveFilessubFolders,sPath&"\"&FolderName&"\"fso.DeleteFolder subFoldersNextEnd Function Function GetLastModify(folder) Set fso =createobject("scripting.FileSystemObject") SetFolder=fso.getFolder(folder) Set subFolders =Folder.Files nowdate= Now For Each subFolder InsubFolders dic.Adddatediff("s",subFolder.DateLastModified,nowdate),subFolder.path Next NumArray=dic.Keys bn = NumArray(0) For Each nn In NumArray If bn >= nn Then bn = nn End If Next GetLastModify =dic.Item(bn)End Function Function fSortArray(aSortThisArray)Dim oArrayList, iElementSet oArrayList = CreateObject("System.Collections.ArrayList" )For iElement = 0 To UBound(aSortThisArray)oArrayList.Add aSortThisArray(iElement)NextoArrayList.Sortset fSortArray = oArrayListEnd Function ''拷贝文件Function CopyFiles(yPath,sPath)On Error Resume NextDim folder,Files,File,subFolder,subFoldersSet fso =createobject("scripting.FileSystemObject")Set Folder = fso.getFolder(yPath)Set Files = Folder.Files'msgbox yPath & sPahtFor Each File In Filesfso.copyFile File,sPath&"\"'msgbox FileNextSet subFolder = Folder.SubFoldersFor Each subFolders In subFolderfolderTemp = Split(subFolders,"\")FolderName=FolderTemp(ubound(folderTemp))fso.createFolder(sPath&"\"&FolderName)CopyFilessubFolders,sPath&"\"&FolderName&"\"'fso.DeleteFolder subFoldersNextEnd Function
我们可以看见，如果有多个目录的话，我们把函数以外的数据进行了多条执行，但是这样不科学，我们可以采用arry的方式，所以修改见下：
sourcefilespath = Array("D:\data" , "D:\data2")desfilepath = Array("D:\dbbackup\"&""&Year(date)&-Month(date)&-Day(date)&" "&Hour(time)&-Minute(time)&"\" , "D:\dbbackup\"&""&Year(date)&-Month(date)&-Day(date)&" "&Hour(time)&-Minute(time)&"\")Set dic=CreateObject("Scripting.Dictionary")Set fso=CreateObject("Scripting.FileSystemObject")For Each destfold In desfilepathIf Not fso.FolderExists(desfilepath) Thenfso.CreateFolder desfilepathEnd IfNextWScript.QuitFor Each srcfile In sourcefilespathbackFolderPath=GetLastModify(srcfile)For Each destfold In desfilepathfso.CopyFile backFolderPath,destfold&fso.GetFileName(destfold)nextnextmsgbox "Finish"''移动文件Function MoveFiles(yPath,sPath)On Error Resume NextDim folder,Files,File,subFolder,subFoldersSet fso = createobject("scripting.FileSystemObject")Set Folder = fso.getFolder(yPath)Set Files = Folder.Files'msgbox yPath & sPahtFor Each File In Filesfso.MoveFile File,sPath&"\"'msgbox FileNextSet subFolder = Folder.SubFoldersFor Each subFolders In subFolderfolderTemp = Split(subFolders,"\")FolderName=FolderTemp(ubound(folderTemp))fso.createFolder(sPath&"\"&FolderName)MoveFiles subFolders,sPath&"\"&FolderName&"\"fso.DeleteFolder subFoldersNextEnd FunctionFunction GetLastModify(folder) Set fso = createobject("scripting.FileSystemObject") Set Folder=fso.getFolder(folder) Set subFolders = Folder.Files nowdate= Now For Each subFolder In subFolders dic.Add datediff("s",subFolder.DateLastModified,nowdate),subFolder.path Next NumArray=dic.Keys bn = NumArray(0) For Each nn In NumArray If bn >= nn Then bn = nn End If Next GetLastModify = dic.Item(bn)End FunctionFunction fSortArray(aSortThisArray)Dim oArrayList, iElementSet oArrayList = CreateObject( "System.Collections.ArrayList" )For iElement = 0 To UBound(aSortThisArray)oArrayList.Add aSortThisArray(iElement)NextoArrayList.Sortset fSortArray = oArrayListEnd Function''拷贝文件Function CopyFiles(yPath,sPath)On Error Resume NextDim folder,Files,File,subFolder,subFoldersSet fso = createobject("scripting.FileSystemObject")Set Folder = fso.getFolder(yPath)Set Files = Folder.Files'msgbox yPath & sPahtFor Each File In Filesfso.copyFile File,sPath&"\"'msgbox FileNextSet subFolder = Folder.SubFoldersFor Each subFolders In subFolderfolderTemp = Split(subFolders,"\")FolderName=FolderTemp(ubound(folderTemp))fso.createFolder(sPath&"\"&FolderName)CopyFiles subFolders,sPath&"\"&FolderName&"\"'fso.DeleteFolder subFoldersNextEnd Function
本文出自 “高文龙” 博客，谢绝转载！