Well after not being satisfied with these options, I ended up looking for a directory monitor that would run a VBS file on a regular basis. I found a great little utility from I ended up using: Directory Monitor from
http://www.deventerprise.net/Projects.aspx. I have included a copy of my script for future reference. Perhaps someone will one day turn the vbs into a little executable.
My script will
1. Locate all shortcuts in your \AppData\Roaming\Microsoft\Windows\Recent folder
2. Delete all shortcuts that contain drive letters
F through
Z.
If you want to customize this yourself to keep shortcuts for some folders, simply delete the areas in this script that contain drive letters you want to retain in your Recent Places or Recent Items. For example, if you want to
keep shortcuts to drive H, then delete the following from the script.
CleanPath = "H:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End IfFormatted for
Visual Basic with the GeSHI Syntax Highlighter [
copy or print]
Dim objShell, objFSO, CleanPath, fileFolder
Dim userFolder, desktopFolder, custFolder, extension
Dim fullname, shortcut, shortTarget
Dim WshS
Set WshS = WScript.CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
'Expand Environment
'Create const's to spare time and place
usrProfile = WshS.ExpandEnvironmentStrings("%UserProfile%")
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set searchFolder = objFSO.GetFolder(usrProfile & "\AppData\Roaming\Microsoft\Windows\Recent")
Set custFolder = searchFolder.Files
For Each custFile in custFolder
extension = objFSO.GetExtensionName(LCase(custFile.name))
If extension = "lnk" then
'Find full path of target within shortcut
fullname = objFSO.GetAbsolutePathName(custFile)
'See http://www.devguru.com/Technologies/wsh/quickref/wshshell_CreateShortcut.html
'for more information on how this works.
Set shortcut = objShell.CreateShortcut(fullname)
shortTarget = shortcut.TargetPath
Dim myFileToDelete
CleanPath = "F:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "G:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "H:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "I:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "J:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "K:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "L:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "M:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "N:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "O:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "P:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "Q:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "R:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "S:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "T:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "U:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "V:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "W:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "X:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "Y:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
CleanPath = "Z:\"
If InStr(shortTarget, CleanPath) then
Set myFileToDelete = objFSO.GetFile(fullname)
myFileToDelete.Delete
End If
End If
Next
How to implement my Recent Places hack described above:
1. Copy the above script into a folder on your computer (anywhere will do) as RecentPlacesSanitizer.vbs
2. Install Directory Monitor
3. Add your Recent Items folder as a folder you want to monitor (c:\users\
YOUR USERNAME HERE\AppData\Roaming\Microsoft\Windows\Recent)
3. Specify to run the VB script you have copied above each time this folder changes
Logged
...There shouldn't be that many targets to hide.
