#1 08 Oct 2018 23:51

NDog
Member
From: New Zealand
Registered: 31 May 2006
Posts: 116
Website

Windows 10 pin icons to taskbar

Use the following script to systematically pin shortcuts to the taskbar in Windows 10
It is very fast and should take 1~3 seconds to pin everything depending on amount of shortcuts created

Steps
1 - clears the existing taskbar
2 - restarts explorer
3 - pins files directly OR files with arguments generate a shortcut in temp folder, which is then pinned

Supports
- shortcuts with arguments
- windows app shortcuts (eg windows 10 mail)
- local appdata shortcuts (eg spotify)

todo:
unpin windows 10 mail without powershell

win10-pin.vbs

' pin icons to the taskbar
' version 2.5 - ndog
'
' thanks to Alex Weinberger and stuartp79 for PinTo10v2
' parts of code used from https://stackoverflow.com/questions/31720595/pin-program-to-taskbar-using-ps-in-windows-10 
'
' you can define as many shortcuts as you like however icons will only be pinned that exist
' explorer shell must be loaded first in order to properly execute
' if running from GPO, this script must appear under Admin Templates > System > Logon > Run these programs at user logon
'
' If using roaming profiles, the taskbar icons will follow you around, use %appdata% for flag file location
' If using local profiles, the taskbar icons will not follow you around, use %userprofile% for flag file location
'
' Only tested under Windows 10

' initialise objects
Set WshShell   = CreateObject("WScript.Shell")
Set objFSO     = CreateObject("Scripting.FileSystemObject")
Set WshProcEnv = WshShell.Environment("Process")

' check flag
sFlagDir = WshProcEnv("APPDATA")
sFlag    = "taskbar.flag"
'If objFSO.FileExists(sFlagDir & "\" & sFlag) Then Wscript.Quit

' shortcut array variables
s_sn = 0 'ShortcutName (optional - if omitted then inbuilt binary name is used)
s_ef = 1 'exefile (required)
s_wd = 2 'workingdir (optional)
s_ar = 3 'argument (optional)
s_il = 4 'iconlocation (optional)

' create array of shortcuts to create
Dim aShortcut(100,4)

' Explorer
aShortcut(0,1) = "c:\windows\explorer.exe"

' Browsers
aShortcut(1,1) = "C:\Program Files (x86)\Internet Explorer\iexplore.exe"
aShortcut(2,1) = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
aShortcut(3,1) = "C:\Program Files\Google\Chrome\Application\chrome.exe"
aShortcut(4,1) = "C:\Program Files\Mozilla Firefox\firefox.exe"

' Kamar
aShortcut(6,0) = "KAMAR"
aShortcut(6,1) = "C:\Program Files\FileMaker\FileMaker Pro 17 Advanced\FileMaker Pro Advanced.exe"
aShortcut(6,3) = "C:\Program Files\FileMaker\FileMaker Pro 17 Advanced\KAMAR.fmp12"

' Snipping tool
'aShortcut(7,0) = "Snipping Tool"
'aShortcut(7,1) = WshProcEnv("WINDIR") & "\System32\SnippingTool.exe"

' Outlook 2016
'aShortcut(8,0) = "Outlook 2016"
'aShortcut(8,1) = "C:\Program Files (x86)\Microsoft Office\root\Office16\OUTLOOK.EXE"
'aShortcut(9,0) = "Outlook 2016"
'aShortcut(9,1) = "C:\Program Files\Microsoft Office\Office16\OUTLOOK.EXE"
'aShortcut(10,0) = "Outlook 2016"
'aShortcut(10,1) = "C:\Program Files (x86)\Microsoft Office\Office16\OUTLOOK.EXE"
' Windows Mail
'aShortcut(11,0) = "Mail"
'aShortcut(11,1) = "c:\windows\explorer.exe"
'aShortcut(11,2) = "c:\windows"
'aShortcut(11,3) = "shell:AppsFolder\microsoft.windowscommunicationsapps_8wekyb3d8bbwe!microsoft.windowslive.mail"
'aShortcut(11,4) = "C:\Windows\System32\SHELL32.dll, 156"
' TxTStream Stand-alone SMS
aShortcut(11,0) = "TxTStream"
aShortcut(11,1) = "C:\Program Files (x86)\TxTStream Ltd\TxTStream Stand-alone SMS\SMSStandalone.exe"
aShortcut(11,4) = "C:\Windows\System32\SHELL32.dll, 196"

' office 2016 (o365 install)
aShortcut(12,1) = "C:\Program Files (x86)\Microsoft Office\root\Office16\ONENOTE.EXE"
'aShortcut(13,1) = "C:\Program Files (x86)\Microsoft Office\root\Office16\WINWORD.EXE"
'aShortcut(14,1) = "C:\Program Files (x86)\Microsoft Office\root\Office16\EXCEL.EXE"
' office 2016 (standard install x64)
aShortcut(15,1) = "C:\Program Files\Microsoft Office\Office16\ONENOTE.EXE"
'aShortcut(16,1) = "C:\Program Files\Microsoft Office\Office16\WINWORD.EXE"
'aShortcut(17,1) = "C:\Program Files\Microsoft Office\Office16\EXCEL.EXE"
' office 2016 (standard install x86)
aShortcut(18,1) = "C:\Program Files (x86)\Microsoft Office\Office16\ONENOTE.EXE"
'aShortcut(19,1) = "C:\Program Files (x86)\Microsoft Office\Office16\WINWORD.EXE"
'aShortcut(20,1) = "C:\Program Files (x86)\Microsoft Office\Office16\EXCEL.EXE"

' techie stuff
aShortcut(21,1) = "C:\Program Files (x86)\ABTutor\ABTutor.exe"
aShortcut(22,1) = WshProcEnv("APPDATA") & "\Spotify\Spotify.exe"
aShortcut(23,1) = "C:\Program Files\Notepad++\notepad++.exe"
aShortcut(24,1) = "C:\Program Files (x86)\Notepad++\notepad++.exe"
aShortcut(25,1) = "C:\Program Files (x86)\Emerald Editor Community\Crimson Editor SVN286M\cedt.exe"
aShortcut(26,0) = "SciTE"
aShortcut(26,1) = "C:\Program Files (x86)\AutoIt3\SciTE\SciTE.exe"
aShortcut(27,1) = "C:\Program Files (x86)\TeamViewer\TeamViewer.exe"
aShortcut(28,1) = "C:\Program Files (x86)\VMware\VMware Workstation\vmware.exe"
aShortcut(29,0) = "Active Directory Users and Computers"
aShortcut(29,1) = "C:\Windows\System32\dsa.msc"
aShortcut(30,0) = "Group Policy Management"
aShortcut(30,1) = "C:\Windows\System32\gpmc.msc"
aShortcut(31,0) = "VMware vSphere Client"
aShortcut(31,1) = "C:\Program Files (x86)\VMware\Infrastructure\Virtual Infrastructure Client\Launcher\VpxClient.exe"
aShortcut(32,0) = "PuTTY"
aShortcut(32,1) = "C:\Program Files\PuTTY\putty.exe"
'aShortcut(32,0) = "VbsEdit"
'aShortcut(32,1) = "C:\Program Files\Vbsedit\vbsedit.exe"
aShortcut(36,1) = "C:\Program Files (x86)\VIVOTEK Inc\VAST\Client\VAST2\VAST2.exe"

aShortcut(37,1) = "C:\Program Files\FreeFileSync\FreeFileSync.exe"

' creative cloud
'aShortcut(40,0) = "Creative Cloud"
'aShortcut(40,1) = "C:\Program Files (x86)\Adobe\Adobe Creative Cloud\ACC\Creative Cloud.exe"

' printers
aShortcut(50,0) = "LHSPS01"
aShortcut(50,1) = "c:\windows\explorer.exe"
aShortcut(50,3) = "\\LHSPS01"
aShortcut(50,4) = "%SystemRoot%\system32\shell32.dll,60"
aShortcut(51,0) = "Devices and Printers"
aShortcut(51,1) = "c:\windows\explorer.exe"
aShortcut(51,3) = "shell:::{A8A91A66-3A7D-4424-8D24-04E180695C7A}"
aShortcut(51,4) = "%systemroot%\system32\DeviceCenter.dll"

' logoff
aShortcut(60,0) = "logoff"
aShortcut(60,1) = "C:\Windows\System32\shutdown.exe"
aShortcut(60,3) = "/l"
aShortcut(60,4) = "C:\Windows\System32\SHELL32.dll, 25"


' *********************************************************************************
' clear existing taskbar
Set sFolder = objFSO.GetFolder(WshProcEnv("APPDATA") & "\Microsoft\Internet Explorer\Quick Launch\User Pinned\TaskBar")
Set sFiles = sFolder.Files
For Each File In sFiles
    File.Delete
Next
DeleteHKCUSubkey "Software\Microsoft\Windows\CurrentVersion\Explorer\Taskband"

' unpin PeopleBand
regKey = "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\People\"
WshShell.RegWrite regKey, ""
WshShell.RegWrite regKey & "PeopleBand", "0", "REG_DWORD"

' restart shell
Call RefreshExplorer

' unpin mail - doesn't work in windows 1709+ - use powershell
' WshShell.Run """" & pinTo10bin & """" & " /unpintb ""Mail""", 0, True

' clear temp folder - stops getting stuck on overwriting existing shortcuts
sShortcutTempDir = WshProcEnv("TEMP")
Set sFolder = objFSO.GetFolder(sShortcutTempDir)
Set sFiles = sFolder.Files
For Each File In sFiles
    If Right(File.Name, 4) = ".lnk" Then
        File.Delete
    End If
Next

' generate icons and pin to taskbar
For i = lBound(aShortcut,1) to uBound(aShortcut,1) 'Loop through aInstall packages
	If aShortcut(i,s_sn) = "" And Not aShortcut(i,s_ef) = "" Then
		If objFSO.FileExists(aShortcut(i,s_ef)) Then PinTaskBarNative10(aShortcut(i,s_ef))
	End If
	If Not aShortcut(i,s_sn) = "" And Not aShortcut(i,s_ef) = "" Then
		If objFSO.FileExists(aShortcut(i,s_ef)) Then
			If aShortcut(i,s_wd) = "" Then aShortcut(i,s_wd) = Left(aShortcut(i,s_ef), InStrRev(aShortcut(i,s_ef), "\") - 1) 'Strip path from exefile
			CreateShortcut Array(sShortcutTempDir, aShortcut(i,s_sn), aShortcut(i,s_ef), aShortcut(i,s_wd), aShortcut(i,s_ar), aShortcut(i,s_il))
			PinTaskBarNative10(sShortcutTempDir & "\" & aShortcut(i,s_sn) & ".lnk")
		End If
	End If
Next
' ******************************************************************************

' generate flag
If Not objFSO.FolderExists(sFlagDir) Then BuildFullPath sFlagDir
msg = "Ran " & WScript.ScriptName & vbNewLine
msg = msg & "Workstation: " & WshProcEnv("COMPUTERNAME") & vbNewLine
msg = msg & "User: " & WshProcEnv("USERNAME") & vbNewLine
msg = msg & "Date: " & FormatDateTime(Now, vbGeneralDate) & vbNewLine
msg = msg & vbNewLine
Set objFile = objFSO.OpenTextFile(sFlagDir & "\" & sFlag, 8, True) 'ForAppending = 8
objFile.Write msg
objFile.Close

' end of script


Sub CreateShortcut(rArgs) '(ShortcutLocation, ShortcutName, exefile, workingdir, argument, iconlocation)
	' wscript does not support optional parameters passed to a function, but supports passing objects, arrays and classes - http://www.4guysfromrolla.com/webtech/071801-1.shtml
	'On Error Resume Next
	'Declare local variables and assign empty strings
	Dim v1,v2,v3,v4,v5,v6
	v1 = "" : v2 = "" : v3 = "" : v4 = "" : v5 = "" : v6 = ""
	Select Case UBound(rArgs)
		Case 0
			v1 = rArgs(0)
		Case 1
			v1 = rArgs(0) :	v2 = rArgs(1)
		Case 2
			v1 = rArgs(0) : v2 = rArgs(1) :	v3 = rArgs(2)
		Case 3
			v1 = rArgs(0) : v2 = rArgs(1) : v3 = rArgs(2) : v4 = rArgs(3)
		Case 4
			v1 = rArgs(0) : v2 = rArgs(1) : v3 = rArgs(2) : v4 = rArgs(3) : v5 = rArgs(4)
		Case 5
			v1 = rArgs(0) : v2 = rArgs(1) : v3 = rArgs(2) : v4 = rArgs(3) : v5 = rArgs(4) : v6 = rArgs(5)
	End Select
	'Debug
	'wscript.echo "v1  = " & v1 'ShortcutLocation
	'wscript.echo "v2  = " & v2 'ShortcutName
	'wscript.echo "v3  = " & v3 'exefile
	'wscript.echo "v4  = " & v4 'workingdir
	'wscript.echo "v5  = " & v5 'argument
	'wscript.echo "v6  = " & v6 'iconlocation
	' create shortcut
	If Not objFSO.FolderExists(v1) Then BuildFullPath v1
	sLinkFile = v1 & "\" & v2 & ".lnk"
	Set oLink = WshShell.CreateShortcut(sLinkFile)
	if v3 <> "" Then oLink.TargetPath       = v3
	if v4 <> "" Then oLink.WorkingDirectory = v4
	if v5 <> "" Then oLink.Arguments        = """"&v5&""""
	if v6 <> "" Then oLink.IconLocation     = v6
	oLink.Save
	'On Error goto 0
End Sub


Sub BuildFullPath(ByVal FullPath)
	'wscript.echo FullPath
	If Not objFSO.FolderExists(FullPath) Then
		BuildFullPath objFSO.GetParentFolderName(FullPath)
		objFSO.CreateFolder FullPath
	End If
End Sub


Sub DeleteHKCUSubkey(strKeyPath)
	Set objReg = GetObject("winmgmts:\\.\root\default:StdRegProv")
	HKEY_CURRENT_USER = &H80000001
    objReg.EnumKey HKEY_CURRENT_USER, strKeyPath, arrSubkeys
    If IsArray(arrSubkeys) Then
		For Each strSubkey In arrSubkeys
			DeleteHKCUSubkey strKeyPath & "\" & strSubkey
		Next
    End If
    objReg.DeleteKey HKEY_CURRENT_USER, strKeyPath
End Sub


Sub RefreshExplorer()
	Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
	Set colProcess = objWMIService.ExecQuery("Select * from Win32_Process Where Name = 'explorer.exe'")
	For Each objProcess In colProcess
		objProcess.Terminate()
	Next
	WScript.Sleep 500
	For Each objProcess In objWMIService.InstancesOf("Win32_Process")
		If objProcess.Name = "explorer.exe" Then
			Exit Sub
		End If
	Next
	WshShell.Run "explorer.exe"
End Sub


Sub PinTaskBarNative10(fPath)
	objFile = fPath
	sKey1   = "HKCU\Software\Classes\*\shell\{:}\\"
	sKey2   = Replace(sKey1, "\\", "\ExplorerCommandHandler")
	With WScript.CreateObject("WScript.Shell")
		KeyValue = .RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\CommandStore\shell\Windows.taskbarpin\ExplorerCommandHandler")
		.RegWrite sKey2, KeyValue, "REG_SZ"
		With WScript.CreateObject("Shell.Application")
			With .Namespace(objFSO.GetParentFolderName(objFile))
				With .ParseName(objFSO.GetFileName(objFile))
					.InvokeVerb("{:}")
				End With
			End With
		End With
		.Run("Reg.exe delete """ & Replace(sKey1, "\\", "") & """ /F"), 0, True
	End With
End Sub

Last edited by NDog (09 Oct 2018 00:18)


cmd, vbs, ps, bash
autoit, python, swift

Offline

Board footer

Powered by FluxBB