近期有个需求，想对数据的备份目录中数据再次远程拷贝到计算机上，所以我们就通过vbs脚本将备份目录下的最新文件拷贝到指定目录，然后以当前的系统日期命名，总结为下：

我们在D盘下的data目录下有系统的备份文件，然后以日期命名，我们想通过获取文件的最后 一次修改时间进行获取最新文件，然后进行拷贝

image

然后拷贝到指定目录中，我们也可以拷贝到远程计算机

我们在本地进行测试，在D盘下的databackup中即可

image

代码送上：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
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

我们执行脚本后，发现以日期命名，然后将最新的数据拷贝到了这个文件夹路劲下

image

image

如果一个脚本想实现不同目录的数据拷贝的话，我们也可以通过以下方式写，我们有两种，第一种不正规的写法

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
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) Then
fso.CreateFolder desfilepath
  
End If
  
backFolderPath=GetLastModify(sourcefilespath)
fso.CopyFile
backFolderPath,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) Then
fso.CreateFolder desfilepath2
  
End If
  
backFolderPath=GetLastModify(sourcefilespath2)
fso.CopyFile
backFolderPath,desfilepath2&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

我们可以看见，如果有多个目录的话，我们把函数以外的数据进行了多条执行，但是这样不科学，我们可以采用arry的方式，所以修改见下：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
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 desfilepath
If Not fso.FolderExists(desfilepath) Then
fso.CreateFolder desfilepath
End If
Next
WScript.Quit
For Each srcfile In sourcefilespath
backFolderPath=GetLastModify(srcfile)
For Each destfold In desfilepath
fso.CopyFile backFolderPath,destfold&fso.GetFileName(destfold)
next
next
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