近期有个需求,想对数据的备份目录中数据再次远程拷贝到计算机上,所以我们就通过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