备份部分(12楼代码有点错了,现在改回来):- Dim wsh,wshSysEnv,objLink
- Dim objFSO,subFolders,subFolder,Folder,Files,File
- Dim strHOMEDRIVE,strHOMEPATH
- Dim strBackup,strLnkPath,strWorkingDirectory,strTargetPath
-
- Set wsh = CreateObject("WScript.Shell")
- Set wshSysEnv = wsh.Environment("Process")
-
- strHOMEDRIVE = wshSysEnv("HOMEDRIVE")
- strHOMEPATH = wshSysEnv("HOMEPATH")
-
- Set objFSo = CreateObject("Scripting.FileSystemObject")
-
- FindLinks(strHOMEDRIVE & strHOMEPATH & "\Favorites\链接")
-
- Set File = objFSO.CreateTextFile("LinkBackUp.txt",True)
- File.Write strBackup
- File.Close
-
- Set wsh = Nothing
- Set wshSysEnv = Nothing
- Set objFSO = Nothing
- Set Folder = Nothing
- Set subFolders = Nothing
- Set Files = Nothing
- Set File = Nothing
-
- MsgBox "Backup Succeed!",,"TIPs"
-
- Sub FindLinks(strPath)
- Set Folder = objFSO.GetFolder(strPath)
- Set subFolders = Folder.subFolders
- Set Files = Folder.Files
- For Each File In Files
- If LCase(objFSO.GetExtensionName(File.Path)) = "lnk" Then
- Set objLink = wsh.CreateShortcut(File.Path)
- strWorkingDirectory = objLink.WorkingDirectory
- strTargetPath = objLink.TargetPath
- strBackup = strBackup & _
- "LinkPath:" & File.Path & vbCrLf & _
- "LinkTargetPath:" & strTargetPath & vbCrLf & _
- "LinkWorkingDirectory:" & strWorkingDirectory _
- & vbCrLf & vbCrLf
- End If
- Next
- For Each subFolder In subFolders
- FindLinks(subFolder.Path)
- Next
- End Sub
复制代码 还原部分:- Dim wsh,objFSO,f,Folder,strTxtLine,ary,objLink
- Dim strLnkPath,strWorkingDirectory,strTargetPath
-
- set wsh = CreateObject("WScript.Shell")
- Set objFSO = CreateObject("Scripting.FileSystemObject")
- Set f = objFSO.OpenTextFile("LinkBackUp.txt",1)
-
- While Not f.AtEndOfStream
- strTxtLine = f.ReadLine
- If strTxtLine <> "" Then
- ary = Split(strTxtLine,":",-1)
- ReDim Preserve ary(3)
- Select Case ary(0)
- Case "LinkPath"
- strLnkPath = ary(1) & ":" & ary(2)
- Case "LinkTargetPath"
- strTargetPath = ary(1) & ":" & ary(2)
- Case "LinkWorkingDirectory"
- strWorkingDirectory = ary(1) & ":" & ary(2)
- CreateLnk strLnkPath,strTargetPath,strWorkingDirectory
- End Select
- End If
- Wend
-
- f.Close
-
- Set wsh = Nothing
- Set objFSO = Nothing
- Set f= Nothing
-
- MsgBox "Restore Succeed!",Tips
-
- Sub CreateLnk(strLnkPath,strTargetPath,strWorkingDirectory)
- Folder = Left(strLnkPath,InStrRev(strLnkPath,"\"))
- If Not objFSO.FolderExists(Folder) Then
- objFSO.CreateFolder Folder
- End If
- Set objLink = wsh.CreateShortcut(strLnkPath)
- objLink.TargetPath = strTargetPath
- objLink.WorkingDirectory = strWorkingDirectory
- objLink.Save
- Set objLink = Nothing
- End Sub
复制代码
|