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

最新推荐文章于 2021-05-23 22:56:14 发布

CodeMore

最新推荐文章于 2021-05-23 22:56:14 发布

阅读量1.8k

点赞数 1

分类专栏： Windows脚本技术-VBS 文章标签： vbs windows 脚本

本文链接：https://blog.csdn.net/codemore/article/details/51356881

版权

Windows脚本技术-VBS 专栏收录该内容

3 篇文章 0 订阅

订阅专栏

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

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

使用下面的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 专业版

运行截图：