VBS脚本备份桌面文档到指定目录,同时统计文档的信息。

版权声明:本文为博主原创文章,未经博主允许不得转载。 https://blog.csdn.net/CodeMore/article/details/51356881

在日常的计算机使用中,我会经常的更新系统尝鲜,

但是在更新系统之前,大家会备份桌面文档。

使用下面的VBS脚本能够一键复制所有项目到指定的备份目录,与此同时,统计出复制完的每个项目信息。


代码如下:

' Backup the Desktop files and folders and Write to log file
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Copyright (c) 1990-2016 TopStudio
'''脚本名称:一键备份桌面项目到指定目录,同时统计出备份信息。
'''描述:此脚本可以用于重装系统时使用,备份文件到制定文件夹。
'''作者:Zero
'''日期:2016年8月2日
'''版本:0.01
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


On Error Resume Next 
	'常量定义
	Const DESKTOP 				= &H10&
	Const ALL_USERS_DESKTOP 	<span style="white-space:pre">	</span>= &H19&
	
	'全局变量
	Dim MybackupFolderPath		'备份目录路径
	
	GetCurrentDate 	  			= Year(Date())& "-" & Month(Date()) & "-" & Day(Date()) & "-" & Second(Date())
	MyDesktopFilePath 			= "D:\Desktop Filename and their Paths " & GetCurrentDate & ".txt"  '日志文件路径
	
	'计数器
	FolderCount 				= 0  '文件夹
	ItemCount   				= 0	 '项目
	ShortcutCount   			= 0	 '快捷方式
	
	'全局变量
	Set objFSO 		= CreateObject("Scripting.FileSystemObject")
	Set objShell 	= CreateObject("Shell.Application")
	Set objWshShell = CreateObject("Wscript.Shell")
	
	Set objDesktopFolder = objShell.Namespace(DESKTOP)					'桌面路径
	Set objDesktopFolderItem = objDesktopFolder.Self

	Set objPublicDesktopFolder = objShell.Namespace(ALL_USERS_DESKTOP)	'公用桌面路径
	Set objPublicFolderItem = objPublicDesktopFolder.Self
	
ret = MsgBox ("这个小脚本能备份桌面上的文件到指定目录。" & vbCrlf &_
		"同时统计文件信息并保存在D盘的根目录。"& vbCrLf &_
		"单击是(Yes)备份,单击否(No)退出脚本?", vbYesNo + vbInformation, "欢迎使用")
If vbNo = ret Then
	WScript.Quit
Else 
	Set MyTxtFile = objFSO.CreateTextFile(MyDesktopFilePath, True)
	Call BrowerForFolder()
	Call ProcessItems()	
	Call SumUp()
	Call Prompt()
End If


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''过程名:WriteDesktopPath
''功能:将桌面路径和公用桌面路径写出日志文件。
''输入参数:无
''返回值:无
''作者:Zero
''日期:2016年8月2日
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub WriteDesktopPath()
	MyTxtFile.WriteLine "备份时间:" & Now 
	MyTxtFile.WriteLine "你的桌面路径是:"
	MyTxtFile.WriteLine objDesktopFolderItem.Path
	MyTxtFile.WriteLine objPublicFolderItem.Path
	MyTxtFile.WriteLine "统计详细结果:"
	MyTxtFile.WriteLine "**************************************************************************************************************************************"
	MyTxtFile.WriteLine 
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''过程名:ProcessItems
''功能:处理桌面上的每一个项目,调用函数将项目复制到制定目录,调用函数将项目的信息写入日志文件。
''调用:函数:CopyFilesToBackup()、CountAndWriteToLog()
''输入参数:无
''返回值:无
''作者:Zero
''日期:2016年8月2日
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub ProcessItems()
	
	Set colItems = objDesktopFolder.Items
	
	For Each objTmpItem in colItems
	
		CopyFilesToBackup(objTmpItem)		
		CountAndWriteToLog(objTmpItem)
	Next
			
	Set colPublicItems = objPublicDesktopFolder.Items
	
	For Each objItem In colPublicItems
		
		CopyFilesToBackup(objItem)		
    	CountAndWriteToLog(objItem)
	Next 

End Sub 

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''函数名:CopyFilesToBackup
''功能:复制每一个项目到备份目录
''输入参数:	项目对象: objItem
''返回值:无
''作者:Zero
''日期:2016年8月2日
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function CopyFilesToBackup(objItem)
  
  If Not objFSO.FolderExists(MybackupFolderPath) Then 
  		 objFSO.CreateFolder(MybackupFolderPath)
  End If 
  
	Set objTargetFolder = objShell.NameSpace(MybackupFolderPath)
		
		objTargetFolder.CopyHere objItem, FOF_CREATEPROGRESSDLG
		
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''函数名:CountAndWriteToLog
''功能:将需要复制每一个项目的信息(名称、路径)写入日志文件。
''输入参数:	项目对象: objItem
''返回值:无
''作者:Zero
''日期:2016年8月2日
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function CountAndWriteToLog(objItem)
	ItemCount = ItemCount + 1
		
	If objFSO.FolderExists(objItem.Path) Then
    	FolderCount = FolderCount + 1
    	
    Else If objFSO.GetExtensionName(objItem.Path) = "lnk" Then
    	ShortcutCount = ShortcutCount + 1  
    End If 
    End If 
    	
	MyTxtFile.WriteLine "第 " & ItemCount & " 个项目" 
    MyTxtFile.WriteLine "项目名: " &  objItem.Name
    MyTxtFile.WriteLine "项目路径:" & objItem.Path
    MyTxtFile.WriteLine "项目最后修改时间:" & objItem.ModifyDate
	MyTxtFile.WriteLine "---------------------------------------------------"
    MyTxtFile.WriteLine
End Function  


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''过程名:SumUp
''功能:将复制完的结果入日志文件。
''输入参数:无
''返回值:无
''作者:Zero
''日期:2016年8月2日
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub SumUp()
MyTxtFile.WriteLine "*******************************************************************"
MyTxtFile.WriteLine "在您的桌面上找到了 " & ItemCount  & " 个项目。"
MyTxtFile.WriteLine "快捷方式: " & ShortcutCount & "个。"
MyTxtFile.WriteLine "文件夹: " & FolderCount & "个。"
MyTxtFile.WriteLine "文件: " & ItemCount - FolderCount - ShortcutCount & "个。"
MyTxtFile.Close
End Sub 

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''过程名:Prompt
''功能:提示用户是否打开日志文件。
''输入参数:无
''返回值:无
''作者:Zero
''日期:2016年8月2日
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub Prompt()
choice = MsgBox("您的日志文件位于" & vbCrLf & MyDesktopFilePath & vbCrLf & "现在打开日志文件么?", vbYesNo + vbInformation, "提示")
If choice = vbYes Then
	objWshShell.Run "notepad " & MyDesktopFilePath, 3, True
Else 
	WScript.Quit
End If 
End Sub 

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''过程名:BrowerForFolder
''功能:打开浏览文件夹对话框并选择备份文件夹。如果用户没有选择,设置默认备份文件夹为D:\My Backup
''输入参数:无
''返回值:无
''作者:Zero
''日期:2016年8月2日
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub BrowerForFolder()

on error resume Next
	Const MY_COMPUTER			=&H11&
	Const WINDOW_HANDLE			=0
	Const OPTIONS				=0
	Const FOF_CREATEPROGRESSDLG = &H0&
	'设置我的电脑为根目录

Set objComputerFolder=objShell.Namespace(MY_COMPUTER)
Set objComFolderItem=objComputerFolder.Self
strPath=objComFolderItem.Path

Set objBrowerFolder=objShell.BrowseForFolder(WINDOWS_HANDLE,"请选择一个文件夹用于备份:",OPTIONS,strPath)
 
If objBrowerFolder Is Nothing Then
	If vbyes = MsgBox("你所选择的目录为空!" & vbCrLf & "是否设置默认备份目录为" & vbCrLf &_
					 "D:\My Backup", vbYesNo + vbExclamation, "提示") Then 
   			MybackupFolderPath = "D:\My backup"
   	Else 
   	 		WScript.Quit
   	End If 
   	
End If


Set objTmpFolderItem=objBrowerFolder.Self
	MybackupFolderPath=objTmpFolderItem.Path

	If MybackupFolderPath = "" Then
  	 	MybackupFolderPath = "D:\My backup"	
	End If
End Sub 


测试环境:Windows 10 X64 专业版

运行截图:








展开阅读全文

没有更多推荐了,返回首页