VBS 提取最近打开的文件、删除“最近访问的位置”中失效的快捷方式 by yu2n

yu2n

VBS 提取最近打开的文件、删除“最近访问的位置”中失效的快捷方式 by yu2n

1. 'VBS 提取最近打开的文件、删除“最近访问的位置”中失效的快捷方式 by yu2n
   
2. Const sAppTitle = "* VBS 复制最近打开的文件 by Yu2n *"
   
3. Dim wso, fso, oShell, oFolder, sSrcFolder, sDesFolder, sFilterFile, oFile, oType, sSrcFile, sDesFile
   
4. Set wso = CreateObject("Wscript.Shell")
   
5. Set fso = CreateObject("Scripting.FileSystemObject")
   
6. Set oShell = CreateObject("Shell.Application")
   
7. 
   
8. '来源文件夹
   
9. sSrcFolder = wso.SpecialFolders("Recent")  '最近打开的文件
   
10. 
    
11. '过滤文件类型
    
12. sFilterFile = InputBox("请输入要保存的文件类型：" & vbCrLf & vbCrLf & vbCrLf & vbCrLf & _
    
13.   "多个文件类型，使用 “|” 符号分隔开", "Step 1/2 - " & sAppTitle, "txt|vbs|ppt")
    
14. If sFilterFile = "" Then WScript.Quit
    
15. 
    
16. '打开最近访问
    
17. wso.Run "explorer /e," & sSrcFolder
    
18. 
    
19. '目标文件夹
    
20. Set oFolder = CreateObject("Shell.Application").BrowseForFolder(&H0, _
    
21.   "Step 2/2 - 请选择保存的位置：", &H0010 + &H0001)
    
22. If (Not oFolder Is Nothing) Then sDesFolder = oFolder.Self.Path
    
23. If Not fso.FolderExists(sDesFolder) Then WScript.Quit
    
24. '扫描来源文件夹
    
25. Set oFolder = oShell.NameSpace(sSrcFolder)
    
26. For Each oFile in fso.GetFolder(sSrcFolder).Files
    
27.   '限定文件类型必须为快捷方式
    
28.   If UCase(Right(oFile.Name, Len(".lnk"))) = UCase(".lnk") Then
    
29.     '快捷方式指向的文件
    
30.     sSrcFile = oFolder.ParseName(oFile.Name).GetLink.Path
    
31.     If fso.FileExists(sSrcFile) Then
    
32.       '过滤文件类型
    
33.       For Each oType In Split(sFilterFile, "|")
    
34.         oType = "." & Trim(oType) & ".lnk"
    
35.         If UCase(Right(oFile.Name,Len(oType))) = UCase(oType) Then
    
36.           '复制文件
    
37.           sDesFile = sDesFolder & "" & Left(oFile.Name, Len(oFile.Name)-Len(".lnk"))
    
38.           If (Not fso.FileExists(sDesFile)) Then
    
39.             fso.CopyFile sSrcFile, sDesFile, True
    
40.           End If
    
41.         End If
    
42.       Next
    
43.     Else
    
44.       '删除失效的快捷方式(快捷方式指向的文件不存在)
    
45.       fso.DeleteFile oFile, True
    
46.     End If
    
47.   End If
    
48. Next
    
49. 
    
50. Msgbox "完成！" & String(70,Chr(32)), vbSystemModal+vbInformation, sAppTitle
    

复制代码