List All Shortcut Hotkeys Currently in Use [Windows]

ListHotKeys.vbs

'Script Info: Obtains the List of Shortcuts With a Hotkey assigned
'Author: Ramesh Srinivasan, for The Winhelponline Blog
'https://www.winhelponline.com/blog/list-all-hotkeys-used-shortcuts-script/
'Created on May 5 2016
'Modified on May 19 2016
'Reviewed on May 22 2021
'URL: https://www.winhelponline.com/blog

Option Explicit
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim WshShell: Set WshShell = WScript.CreateObject("WScript.Shell")
Dim arrFolders, objFolder, fldr, colfiles, colFolders
Dim objFile, objSubFolder, oShellLink, strHotKey

arrFolders = Array ( _
WshShell.SpecialFolders("AllUsersDesktop") _
, WshShell.SpecialFolders("Desktop") _
, WshShell.SpecialFolders("AllUsersStartMenu") _
, WshShell.SpecialFolders("StartMenu") _
, WshShell.SpecialFolders("AppData") & _
"\Microsoft\Internet Explorer\Quick Launch" _
)

For Each fldr In arrFolders
	If objFSO.FolderExists (fldr) Then Call GetHotKeys (fldr)
Next

Sub GetHotKeys (strFolder)
	Set objFolder = objFSO.GetFolder(strFolder)
	Set colFiles = objFolder.Files
	For Each objFile In colFiles
		If LCase(objFSO.GetExtensionName(objFile.Name)) = "lnk" Then
			Set oShellLink = WshShell.CreateShortcut(objFile.Path)
			If Trim(oShellLink.Hotkey) <> "" Then
				strHotKey = strHotKey & "[" & Trim(oShellLink.Hotkey) & _
				"]" & vbCrLf & objFile.Path & vbCrLf & vbCrLf
			End If
		End If
	Next
	Set colFolders = objFolder.SubFolders
	For Each objSubFolder In colFolders
		GetHotKeys(objSubFolder)
	Next
End Sub

WshShell.PopUp strHotKey,,"Hotkeys Curently in Use by Shortcuts", 64
Set WshShell = Nothing
Set objFSO = Nothing