Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
HotKeys?
Sub GenerateFullHotkeyList
on error resume next
Set objShell = CreateObject("Shell.Application")
' GenerateFullHotkeyInFolder(objShell.NameSpace(11)) '
GenerateFullHotkeyInFolder(objShell.NameSpace(17)) 'My Comp
headrow = "<THEAD class=instruct>" & vbcrlf & "<TR><TD WIDTH=" & chr(34) & "20%" & chr(34) & "><b>Key</b></TD><TD WIDTH=" & chr(34) & "35%" & chr(34) & "><b>Shortcut Location</b><br>Click to find in Explorer</TD><TD WIDTH=" & chr(34) & "35%" & chr(34) & "><b>Target</b><br>Click to find in Explorer</TD></TR></THEAD>"
If DiagVar<>"" then
FullHotKeyList.InnerHTML = "<table id=tfullhotkeylist>" & headrow & DiagVar & "</table>"
Else
FullHotKeyList.InnerHTML = "<p style='color:red'><b>No hotkeys found</b></p>"
End If
DiagVar =""
PrettyTable(tfullhotkeylist)
End Sub
Sub GenerateFullHotkeyInFolder(Fldr)
on error resume next
set WshShell = CreateObject("WScript.Shell")
Set objShell = CreateObject("Shell.Application")
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dict=CreateDictionary()
Set FldrItems=Fldr.Items
For Each oFile in FldrItems
With oFile
If .IsFileSystem = true And .IsLink = true And .Type <> "Shortcut to MS-DOS Program" then
set lnk = .GetLink
If lnk.hotkey <> 0 then
Set fsop = fso.GetFile(.Path)
LnkName = "<b>" & fso.GetBaseName(fso.GetFile(.Path)) & "</b><br>" & fsop.ParentFolder.path & "\" & fso.GetBaseName(fso.GetFile(.Path)) & "." & fso.GetExtensionName(fso.GetFile(.Path))
HK=Dict.Item(lnk.hotkey AND 255)
If HK = "" then HK = "A reserved or OEM specific key"
Modkey =""
If (lnk.hotkey And 256) = 256 then Modkey = "Shift + "
If (lnk.hotkey And 512) = 512 then Modkey = ModKey + "Ctrl + "
If (lnk.hotkey And 1024) = 1024 then Modkey = ModKey + "Alt + "
If (lnk.hotkey And 2048) = 2048 then Modkey = ModKey + "Winkey + "
DiagVar = DiagVar & "<tr><td><b>" & ModKey & " " & HK & "</b></td><td><a class=TblURL onmouseover='MakeRed()' onmouseout='MakeBlack()' onclick='FindShortcut(" & Chr(34) & .path & Chr(34) & ")'>" & LnkName & "</a>" & "</td><td><a class=TblURL onmouseover='MakeRed()' onmouseout='MakeBlack()' onclick='FindShortcut(" & Chr(34) & lnk.path & Chr(34) & ")'>" & lnk.path & "</a></td></tr>" & vbcrlf
End If
ElseIf .IsFileSystem = true And .IsFolder = true then
GenerateFullHotkeyInFolder(.GetFolder)
End If
End With
Next
End Sub
@corbob
Copy link
Author

corbob commented May 15, 2019

Loading

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment