Solved Pin to Taskbar with VB Script

ws2000

New Member
Messages
2
Hello

Is it still possible to use the VB script in Windows 8 that many of us used to pin programs and shortcuts in Windows 7. I just have a couple items I would like to have pinned on users desktop taskbars and the script below worked perfect in Windows 7. I tried it today and nothing gets pinned but it still deletes itself. Any ideas? I did verify I had the .lnk in the locations below.

Thank you!


Code:
Option Explicit


Const CSIDL_COMMON_PROGRAMS = &H17
Const CSIDL_PROGRAMS = &H2
Const CSIDL_STARTMENU = &HB


Dim objShell, objFSO
Dim objCurrentUserStartFolder
Dim strCurrentUserStartFolderPath
Dim objAllUsersProgramsFolder
Dim strAllUsersProgramsPath
Dim objFolder
Dim objFolderItem
Dim colVerbs
Dim objVerb


Set objShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objCurrentUserStartFolder = objShell.NameSpace (CSIDL_STARTMENU)
strCurrentUserStartFolderPath = objCurrentUserStartFolder.Self.Path
Set objAllUsersProgramsFolder = objShell.NameSpace(CSIDL_COMMON_PROGRAMS)
strAllUsersProgramsPath = objAllUsersProgramsFolder.Self.Path


' - Pin to Taskbar -


'Microsoft Outlook 2013
If objFSO.FileExists(strAllUsersProgramsPath & "\Microsoft Office 2013\Outlook 2013.lnk") Then
    Set objFolder = objShell.Namespace(strAllUsersProgramsPath & "\Microsoft Office 2013")
    Set objFolderItem = objFolder.ParseName("Outlook 2013.lnk")
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
        If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
    Next
End If

'Snipping Tool
If objFSO.FileExists(strCurrentUserStartFolderPath & "\Programs\Accessories\Snipping Tool.lnk") Then
    Set objFolder = objShell.Namespace(strCurrentUserStartFolderPath & "\Programs\Accessories")
    Set objFolderItem = objFolder.ParseName("Snipping Tool.lnk")
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
        If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
    Next
End If

'Delete the script
DeleteSelf


Sub DeleteSelf()       
        Dim objFSO
        'Create a File System Object
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        'Delete the currently executing script
        objFSO.DeleteFile WScript.ScriptFullName
        Set objFSO = Nothing
End Sub
 
Last edited by a moderator:

My Computer

System One

  • OS
    Windows 8

My Computer

System One

  • OS
    64-bit Windows 10
    Computer type
    PC/Desktop
    System Manufacturer/Model
    Custom self built
    CPU
    Intel i7-8700K OC'd to 5 GHz
    Motherboard
    ASUS ROG Maximus XI Formula Z390
    Memory
    64 GB (4x16GB) G.SKILL TridentZ RGB DDR4 3600 MHz (F4-3600C18D-32GTZR)
    Graphics Card(s)
    ASUS ROG-STRIX-GTX1080TI-O11G-GAMING
    Sound Card
    Integrated Digital Audio (S/PDIF)
    Monitor(s) Displays
    2 x Samsung Odyssey G7 27"
    Screen Resolution
    2560x1440
    Hard Drives
    1TB Samsung 990 PRO M.2,
    4TB Samsung 990 PRO PRO M.2,
    8TB WD MyCloudEX2Ultra NAS
    PSU
    OCZ Series Gold OCZZ1000M 1000W
    Case
    Thermaltake Core P3
    Cooling
    Corsair Hydro H115i
    Keyboard
    Logitech wireless K800
    Mouse
    Logitech MX Master 3
    Internet Speed
    1 Gb/s Download and 35 Mb/s Upload
    Browser
    Internet Explorer 11
    Antivirus
    Malwarebyte Anti-Malware Premium
    Other Info
    Logitech Z625 speaker system,
    Logitech BRIO 4K Pro webcam,
    HP Color LaserJet Pro MFP M477fdn,
    APC SMART-UPS RT 1000 XL - SURT1000XLI,
    Galaxy S23 Plus phone
Its working again now. A couple mistakes and in my profile C:\Users\Me\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\ the Accessories folder is displayed as Windows Accessories but is still just Accessories for scripting. I fixed the script above. Hopefully it saves someone the hour I lost. :)

Thanks.
 

My Computer

System One

  • OS
    Windows 8
Great news. :)
 

My Computer

System One

  • OS
    64-bit Windows 10
    Computer type
    PC/Desktop
    System Manufacturer/Model
    Custom self built
    CPU
    Intel i7-8700K OC'd to 5 GHz
    Motherboard
    ASUS ROG Maximus XI Formula Z390
    Memory
    64 GB (4x16GB) G.SKILL TridentZ RGB DDR4 3600 MHz (F4-3600C18D-32GTZR)
    Graphics Card(s)
    ASUS ROG-STRIX-GTX1080TI-O11G-GAMING
    Sound Card
    Integrated Digital Audio (S/PDIF)
    Monitor(s) Displays
    2 x Samsung Odyssey G7 27"
    Screen Resolution
    2560x1440
    Hard Drives
    1TB Samsung 990 PRO M.2,
    4TB Samsung 990 PRO PRO M.2,
    8TB WD MyCloudEX2Ultra NAS
    PSU
    OCZ Series Gold OCZZ1000M 1000W
    Case
    Thermaltake Core P3
    Cooling
    Corsair Hydro H115i
    Keyboard
    Logitech wireless K800
    Mouse
    Logitech MX Master 3
    Internet Speed
    1 Gb/s Download and 35 Mb/s Upload
    Browser
    Internet Explorer 11
    Antivirus
    Malwarebyte Anti-Malware Premium
    Other Info
    Logitech Z625 speaker system,
    Logitech BRIO 4K Pro webcam,
    HP Color LaserJet Pro MFP M477fdn,
    APC SMART-UPS RT 1000 XL - SURT1000XLI,
    Galaxy S23 Plus phone
Back
Top