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

yu2n

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

'VBS 提取最近打开的文件、删除“最近访问的位置”中失效的快捷方式 by yu2n
Const sAppTitle = "* VBS 复制最近打开的文件 by Yu2n *"
Dim wso, fso, oShell, oFolder, sSrcFolder, sDesFolder, sFilterFile, oFile, oType, sSrcFile, sDesFile
Set wso = CreateObject("Wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("Shell.Application")

'来源文件夹
sSrcFolder = wso.SpecialFolders("Recent")  '最近打开的文件

'过滤文件类型
sFilterFile = InputBox("请输入要保存的文件类型：" & vbCrLf & vbCrLf & vbCrLf & vbCrLf & _
  "多个文件类型，使用 “|” 符号分隔开", "Step 1/2 - " & sAppTitle, "txt|vbs|ppt")
If sFilterFile = "" Then WScript.Quit

'打开最近访问
wso.Run "explorer /e," & sSrcFolder

'目标文件夹
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(&H0, _
  "Step 2/2 - 请选择保存的位置：", &H0010 + &H0001)
If (Not oFolder Is Nothing) Then sDesFolder = oFolder.Self.Path
If Not fso.FolderExists(sDesFolder) Then WScript.Quit
'扫描来源文件夹
Set oFolder = oShell.NameSpace(sSrcFolder)
For Each oFile in fso.GetFolder(sSrcFolder).Files
  '限定文件类型必须为快捷方式
  If UCase(Right(oFile.Name, Len(".lnk"))) = UCase(".lnk") Then
    '快捷方式指向的文件
    sSrcFile = oFolder.ParseName(oFile.Name).GetLink.Path
    If fso.FileExists(sSrcFile) Then
      '过滤文件类型
      For Each oType In Split(sFilterFile, "|")
        oType = "." & Trim(oType) & ".lnk"
        If UCase(Right(oFile.Name,Len(oType))) = UCase(oType) Then
          '复制文件
          sDesFile = sDesFolder & "\" & Left(oFile.Name, Len(oFile.Name)-Len(".lnk"))
          If (Not fso.FileExists(sDesFile)) Then
            fso.CopyFile sSrcFile, sDesFile, True
          End If
        End If
      Next
    Else
      '删除失效的快捷方式(快捷方式指向的文件不存在)
      fso.DeleteFile oFile, True
    End If
  End If
Next

Msgbox "完成！" & String(70,Chr(32)), vbSystemModal+vbInformation, sAppTitle
复制代码