Need Help to Modify Pinning Shortcut VBScript

Home Forums Scripting Windows Script Host Need Help to Modify Pinning Shortcut VBScript

This topic contains 7 replies, has 3 voices, and was last updated by Avatar Shazam 3 years, 4 months ago.

Viewing 8 posts - 1 through 8 (of 8 total)
  • Author
    Posts
  • Avatar
    Shazam
    Member
    #164850

    Hi,

    Rems resolved an issue for me by using this code below. You can read the thread by clicking the link below.

    http://forums.petri.com/showthread.php?t=65971

    Set WshShell = CreateObject(“WScript.Shell”)
    Set objShell = CreateObject(“Shell.Application”)

    strTartgetFile = “\filesDATAHRPhone ListPhoneListPHONELST.pdf”

    ShortcutName = “PHONELST”
    ShortcutFolder = WshShell.SpecialFolders.Item(“Desktop”)
    ShortcutFile = ShortcutName & “.lnk”

    call PinToTaskbar(“unpin”)

    FilePath = ShortcutFolder & “” & ShortcutFile

    With WshShell.CreateShortcut(FilePath)
    .TargetPath = GetProgramAssocWith(“PDF”)
    .Arguments = “””” & strTartgetFile & “”””
    .WorkingDirectory = “.”
    .IconLocation = “imageres.dll, 124”
    .Description = “…”
    .Save
    End With

    call PinToTaskbar(“pin”) : WScript.Sleep 950

    Set objFSO = CreateObject(“Scripting.FileSystemObject”)
    objFSO.DeleteFile(FilePath), true

    wscript.quit

    Function GetProgramAssocWith(strExt)
    Const HKCR=&H80000000
    Const HKCU=&H80000001
    Set objReg = GetObject(“winmgmts:\.rootdefault:StdRegProv”)

    strExt = Replace(strExt,”*”,””)
    If Left(strExt,1) <> “.” Then strExt = “.” & strExt

    strPath = “SoftwareMicrosoftWindowsCurrentVersionExplorerFileExts” & strExt & “UserChoice”
    objReg.GetExpandedStringValue HKCU, strPath, “Progid”, strValue
    If IsNull(strValue) Then
    objReg.GetExpandedStringValue HKCR, strExt, strEntry, strValue
    End If
    If IsNull(strValue) Then wscript.quit

    strPath = strValue & “shellopencommand”
    objReg.GetExpandedStringValue HKCR, strPath, strEntry, strValue
    strValue = Replace(strValue, “”””, “”)

    ‘ [url]http://www.akaplan.com/blog/2010/12/vbscript-to-get-program-associated-with-file-extension/[/url]
    If InStr(strValue,”rundll”) Then
    Dim tArray
    tArray = split(strValue,”,”)
    GetProgramAssocWith = replace(tArray(0),”rundll32.exe”,””)
    Else
    strValue = LCase(strValue)
    GetProgramAssocWith = Left(strValue,instrrev(strValue,”.exe”)+3)
    End If
    End Function

    Sub PinToTaskbar(choice)

    On Error Resume Next

    If Lcase(choice) = “unpin” then

    LnkFolder = WshShell.SpecialFolders.Item(“AppData”)
    LnkFolder = LnkFolder & “MicrosoftInternet ExplorerQuick LaunchUser PinnedTaskBar”
    LnkFile = ShortcutName & “.lnk”

    Set objFolder = objShell.Namespace(LnkFolder)
    Set objFolderItem = objFolder.ParseName(LnkFile)
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
    Select Case Replace(objVerb.name, “&”, “”)
    case “Unpin from Taskbar” objVerb.DoIt
    case “other language …” objVerb.DoIt
    case “other language …” objVerb.DoIt
    case “other language …” objVerb.DoIt
    End Select
    Next

    ElseIf Lcase(choice) = “pin” then

    Set objFolder = objShell.Namespace(ShortcutFolder)
    Set objFolderItem = objFolder.ParseName(ShortcutFile)
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
    Select Case Replace(objVerb.name, “&”, “”)
    case “Pin to Taskbar” objVerb.DoIt
    case “Ajouter au menu Démarrer” objVerb.DoIt
    case “Aggiungi a menu Start” objVerb.DoIt
    case “An Startmenü anheften” objVerb.DoIt
    case “Aan het menu Start vastmaken” objVerb.DoIt
    case “Associar ao Menu Iniciar” objVerb.DoIt
    case “Anclar al menú Inicio” objVerb.DoIt
    End Select
    Next

    End If
    End Sub[/CODE]

    This works very well but I would like if someone can just modify the code just a bit. Currently to open up pdf files on the user’s computer it uses the defaulted Adobe Acrobat program, so the code uses the defaulted pdf program and create a shortcut on the users taskbar. Can the code be modify to use the Adobe Reader application instead, if NOT found, then use the Adobe Acrobat application.
    [B]
    Adobe Reader:[/B]
    C:Program Files (x86)AdobeReader 10.0ReaderAcroRd32.exe

    [B]Adobe Acrobat:[/B]
    C:Program Files (x86)AdobeAcrobat 11.0AcrobatAcrobat.exe

    Any help?[CODE]
    Set WshShell = CreateObject(“WScript.Shell”)
    Set objShell = CreateObject(“Shell.Application”)

    strTartgetFile = “\filesDATAHRPhone ListPhoneListPHONELST.pdf”

    ShortcutName = “PHONELST”
    ShortcutFolder = WshShell.SpecialFolders.Item(“Desktop”)
    ShortcutFile = ShortcutName & “.lnk”

    call PinToTaskbar(“unpin”)

    FilePath = ShortcutFolder & “” & ShortcutFile

    With WshShell.CreateShortcut(FilePath)
    .TargetPath = GetProgramAssocWith(“PDF”)
    .Arguments = “””” & strTartgetFile & “”””
    .WorkingDirectory = “.”
    .IconLocation = “imageres.dll, 124”
    .Description = “…”
    .Save
    End With

    call PinToTaskbar(“pin”) : WScript.Sleep 950

    Set objFSO = CreateObject(“Scripting.FileSystemObject”)
    objFSO.DeleteFile(FilePath), true

    wscript.quit

    Function GetProgramAssocWith(strExt)
    Const HKCR=&H80000000
    Const HKCU=&H80000001
    Set objReg = GetObject(“winmgmts:\.rootdefault:StdRegProv”)

    strExt = Replace(strExt,”*”,””)
    If Left(strExt,1) <> “.” Then strExt = “.” & strExt

    strPath = “SoftwareMicrosoftWindowsCurrentVersionExplorerFileExts” & strExt & “UserChoice”
    objReg.GetExpandedStringValue HKCU, strPath, “Progid”, strValue
    If IsNull(strValue) Then
    objReg.GetExpandedStringValue HKCR, strExt, strEntry, strValue
    End If
    If IsNull(strValue) Then wscript.quit

    strPath = strValue & “shellopencommand”
    objReg.GetExpandedStringValue HKCR, strPath, strEntry, strValue
    strValue = Replace(strValue, “”””, “”)

    http://www.akaplan.com/blog/2010/12/vbscript-to-get-program-associated-with-file-extension/
    If InStr(strValue,”rundll”) Then
    Dim tArray
    tArray = split(strValue,”,”)
    GetProgramAssocWith = replace(tArray(0),”rundll32.exe”,””)
    Else
    strValue = LCase(strValue)
    GetProgramAssocWith = Left(strValue,instrrev(strValue,”.exe”)+3)
    End If
    End Function

    Sub PinToTaskbar(choice)

    On Error Resume Next

    If Lcase(choice) = “unpin” then

    LnkFolder = WshShell.SpecialFolders.Item(“AppData”)
    LnkFolder = LnkFolder & “MicrosoftInternet ExplorerQuick LaunchUser PinnedTaskBar”
    LnkFile = ShortcutName & “.lnk”

    Set objFolder = objShell.Namespace(LnkFolder)
    Set objFolderItem = objFolder.ParseName(LnkFile)
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
    Select Case Replace(objVerb.name, “&”, “”)
    case “Unpin from Taskbar” objVerb.DoIt
    case “other language …” objVerb.DoIt
    case “other language …” objVerb.DoIt
    case “other language …” objVerb.DoIt
    End Select
    Next

    ElseIf Lcase(choice) = “pin” then

    Set objFolder = objShell.Namespace(ShortcutFolder)
    Set objFolderItem = objFolder.ParseName(ShortcutFile)
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
    Select Case Replace(objVerb.name, “&”, “”)
    case “Pin to Taskbar” objVerb.DoIt
    case “Ajouter au menu Démarrer” objVerb.DoIt
    case “Aggiungi a menu Start” objVerb.DoIt
    case “An Startmenü anheften” objVerb.DoIt
    case “Aan het menu Start vastmaken” objVerb.DoIt
    case “Associar ao Menu Iniciar” objVerb.DoIt
    case “Anclar al menú Inicio” objVerb.DoIt
    End Select
    Next

    End If
    End Sub[/CODE]

    This works very well but I would like if someone can just modify the code just a bit. Currently to open up pdf files on the user’s computer it uses the defaulted Adobe Acrobat program, so the code uses the defaulted pdf program and create a shortcut on the users taskbar. Can the code be modify to use the Adobe Reader application instead, if NOT found, then use the Adobe Acrobat application.

    Adobe Reader:

    C:Program Files (x86)AdobeReader 10.0ReaderAcroRd32.exe

    Adobe Acrobat:
    C:Program Files (x86)AdobeAcrobat 11.0AcrobatAcrobat.exe

    Any help?

    Rems
    Rems
    Moderator
    #228455

    Re: Need Help to Modify Pinning Shortcut VBScript

    See the part in Orange from the example below. You can adjust this part as you want.

    • The first orange line is where the path to the executable is hard coded (the path you provided).
    • The second line is where it retrieves the actual program path of AcroRd32.exe from registry, in cases were the OS is 32-bit instead of 64 or when a new or older version of the reader was installed.
    • The third checks if AcroRd32.exe really exists at the provided/retrieved program path. If not exist then the user’s default program voor opening PDFs will be used instead of AcroRd32.exe.

    Set WshShell = CreateObject(“WScript.Shell”)
    Set objShell = CreateObject(“Shell.Application”)
    Set objFSO = CreateObject(“Scripting.FileSystemObject”)

    strTartgetFile = “\filesDATAHRPhone ListPhoneListPHONELST.pdf”

    ShortcutName = “PHONELST”
    ShortcutFolder = WshShell.SpecialFolders.Item(“Desktop”)
    ShortcutFile = ShortcutName & “.lnk”

    On Error Resume Next[COLOR=”DarkOrange”]
    AppPath = “C:Program Files (x86)AdobeReader 11.0ReaderAcroRd32.exe”
    AppPath = WshShell.Regread(“HKLMSOFTWAREMicrosoftWindowsCurrentVersionApp PathsAcroRd32.exe”)
    If (objFSO.FileExists(AppPath)=False) Then AppPath = GetProgramAssocWith(“PDF”)
    [/COLOR]On Error Goto 0

    call PinToTaskbar(“unpin”)

    FilePath = ShortcutFolder & “” & ShortcutFile

    With WshShell.CreateShortcut(FilePath)
    .TargetPath = AppPath
    .Arguments = “””” & strTartgetFile & “”””
    .WorkingDirectory = “.”
    .IconLocation = “imageres.dll, 124”
    .Description = “…”
    .Save
    End With

    call PinToTaskbar(“pin”) : WScript.Sleep 950

    objFSO.DeleteFile(FilePath), true

    wscript.quit

    Function GetProgramAssocWith(strExt)
    Const HKCR=&H80000000
    Const HKCU=&H80000001
    Set objReg = GetObject(“winmgmts:\.rootdefault:StdRegProv”)

    strExt = Replace(strExt,”*”,””)
    If Left(strExt,1) “.” Then strExt = “.” & strExt

    strPath = “SoftwareMicrosoftWindowsCurrentVersionExplorerFileExts” & strExt & “UserChoice”
    objReg.GetExpandedStringValue HKCU, strPath, “Progid”, strValue
    If IsNull(strValue) Then
    objReg.GetExpandedStringValue HKCR, strExt, strEntry, strValue
    End If
    If IsNull(strValue) Then wscript.quit

    strPath = strValue & “shellopencommand”
    objReg.GetExpandedStringValue HKCR, strPath, strEntry, strValue
    strValue = Replace(strValue, “”””, “”)

    http://www.akaplan.com/blog/2010/12/…ile-extension/
    If InStr(strValue,”rundll”) Then
    Dim tArray
    tArray = split(strValue,”,”)
    GetProgramAssocWith = replace(tArray(0),”rundll32.exe”,””)
    Else
    strValue = LCase(strValue)
    GetProgramAssocWith = Left(strValue,instrrev(strValue,”.exe”)+3)
    End If
    End Function

    Sub PinToTaskbar(choice)

    On Error Resume Next

    If Lcase(choice) = “unpin” then

    LnkFolder = WshShell.SpecialFolders.Item(“AppData”)
    LnkFolder = LnkFolder & “MicrosoftInternet ExplorerQuick LaunchUser PinnedTaskBar”
    LnkFile = ShortcutName & “.lnk”

    Set objFolder = objShell.Namespace(LnkFolder)
    Set objFolderItem = objFolder.ParseName(LnkFile)
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
    Select Case Replace(objVerb.name, “&”, “”)
    case “Unpin from Taskbar” objVerb.DoIt
    case “other language …” objVerb.DoIt
    case “other language …” objVerb.DoIt
    case “other language …” objVerb.DoIt
    End Select
    Next

    ElseIf Lcase(choice) = “pin” then

    Set objFolder = objShell.Namespace(ShortcutFolder)
    Set objFolderItem = objFolder.ParseName(ShortcutFile)
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
    Select Case Replace(objVerb.name, “&”, “”)
    case “Pin to Taskbar” objVerb.DoIt
    case “Ajouter au menu Démarrer” objVerb.DoIt
    case “Aggiungi a menu Start” objVerb.DoIt
    case “An Startmenü anheften” objVerb.DoIt
    case “Aan het menu Start vastmaken” objVerb.DoIt
    case “Associar ao Menu Iniciar” objVerb.DoIt
    case “Anclar al menú Inicio” objVerb.DoIt
    End Select
    Next

    End If
    End Sub
    [/CODE][CODE]Set WshShell = CreateObject(“WScript.Shell”)
    Set objShell = CreateObject(“Shell.Application”)
    Set objFSO = CreateObject(“Scripting.FileSystemObject”)

    strTartgetFile = “\filesDATAHRPhone ListPhoneListPHONELST.pdf”

    ShortcutName = “PHONELST”
    ShortcutFolder = WshShell.SpecialFolders.Item(“Desktop”)
    ShortcutFile = ShortcutName & “.lnk”

    On Error Resume Next
    AppPath = “C:Program Files (x86)AdobeReader 11.0ReaderAcroRd32.exe”
    AppPath = WshShell.Regread(“HKLMSOFTWAREMicrosoftWindowsCurrentVersionApp PathsAcroRd32.exe”)
    If (objFSO.FileExists(AppPath)=False) Then AppPath = GetProgramAssocWith(“PDF”)
    On Error Goto 0

    call PinToTaskbar(“unpin”)

    FilePath = ShortcutFolder & “” & ShortcutFile

    With WshShell.CreateShortcut(FilePath)
    .TargetPath = AppPath
    .Arguments = “””” & strTartgetFile & “”””
    .WorkingDirectory = “.”
    .IconLocation = “imageres.dll, 124”
    .Description = “…”
    .Save
    End With

    call PinToTaskbar(“pin”) : WScript.Sleep 950

    objFSO.DeleteFile(FilePath), true

    wscript.quit

    Function GetProgramAssocWith(strExt)
    Const HKCR=&H80000000
    Const HKCU=&H80000001
    Set objReg = GetObject(“winmgmts:\.rootdefault:StdRegProv”)

    strExt = Replace(strExt,”*”,””)
    If Left(strExt,1) “.” Then strExt = “.” & strExt

    strPath = “SoftwareMicrosoftWindowsCurrentVersionExplorerFileExts” & strExt & “UserChoice”
    objReg.GetExpandedStringValue HKCU, strPath, “Progid”, strValue
    If IsNull(strValue) Then
    objReg.GetExpandedStringValue HKCR, strExt, strEntry, strValue
    End If
    If IsNull(strValue) Then wscript.quit

    strPath = strValue & “shellopencommand”
    objReg.GetExpandedStringValue HKCR, strPath, strEntry, strValue
    strValue = Replace(strValue, “”””, “”)

    http://www.akaplan.com/blog/2010/12/…ile-extension/
    If InStr(strValue,”rundll”) Then
    Dim tArray
    tArray = split(strValue,”,”)
    GetProgramAssocWith = replace(tArray(0),”rundll32.exe”,””)
    Else
    strValue = LCase(strValue)
    GetProgramAssocWith = Left(strValue,instrrev(strValue,”.exe”)+3)
    End If
    End Function

    Sub PinToTaskbar(choice)

    On Error Resume Next

    If Lcase(choice) = “unpin” then

    LnkFolder = WshShell.SpecialFolders.Item(“AppData”)
    LnkFolder = LnkFolder & “MicrosoftInternet ExplorerQuick LaunchUser PinnedTaskBar”
    LnkFile = ShortcutName & “.lnk”

    Set objFolder = objShell.Namespace(LnkFolder)
    Set objFolderItem = objFolder.ParseName(LnkFile)
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
    Select Case Replace(objVerb.name, “&”, “”)
    case “Unpin from Taskbar” objVerb.DoIt
    case “other language …” objVerb.DoIt
    case “other language …” objVerb.DoIt
    case “other language …” objVerb.DoIt
    End Select
    Next

    ElseIf Lcase(choice) = “pin” then

    Set objFolder = objShell.Namespace(ShortcutFolder)
    Set objFolderItem = objFolder.ParseName(ShortcutFile)
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
    Select Case Replace(objVerb.name, “&”, “”)
    case “Pin to Taskbar” objVerb.DoIt
    case “Ajouter au menu Démarrer” objVerb.DoIt
    case “Aggiungi a menu Start” objVerb.DoIt
    case “An Startmenü anheften” objVerb.DoIt
    case “Aan het menu Start vastmaken” objVerb.DoIt
    case “Associar ao Menu Iniciar” objVerb.DoIt
    case “Anclar al menú Inicio” objVerb.DoIt
    End Select
    Next

    End If
    End Sub
    [/CODE]

    Avatar
    Shazam
    Member
    #318962

    Re: Need Help to Modify Pinning Shortcut VBScript

    Thank you Rems. It works great.

    One other thing some users have Adobe Reader 10.0 or 11.0. Look at the program path below.

    Adobe Reader:
    C:Program Files (x86)AdobeReader 10.0ReaderAcroRd32.exe

    Or

    C:Program Files (x86)AdobeReader 11.0ReaderAcroRd32.exe

    So I change one thing in your code to act as a wildcard. using “*” .I ran the VBSafter adding the asterisk and it ran just fine, but is that the proper way of doing it?

    [COLOR=DarkOrange]AppPath = “C:Program Files (x86)AdobeReader*ReaderAcroRd32.exe”[/COLOR][/CODE][CODE]AppPath = “C:Program Files (x86)AdobeReader*ReaderAcroRd32.exe”[/CODE]

    Rems
    Rems
    Moderator
    #228456

    Re: Need Help to Modify Pinning Shortcut VBScript

    Shazam;290103 wrote:
    So I change one thing in your code to act as a wildcard. using “*” .I ran the VBSafter adding the asterisk and it ran just fine, but is that the proper way of doing it?

    [COLOR=DarkOrange]AppPath = “C:Program Files (x86)AdobeReader*ReaderAcroRd32.exe”[/COLOR][/CODE][/QUOTE]

    Wildcards in the string is not supported. With the * the file path has become unvalid.

    The AppPath variable is actually defined for a second time by the [COLOR=”DarkOrange”]second orange line[/COLOR] is where it retrieves the program path of AcroRd32.exe from registry.

    Basically the the first orange line is in most cases fully redundant.

    /Rems[CODE]AppPath = “C:Program Files (x86)AdobeReader*ReaderAcroRd32.exe”[/CODE]

    Wildcards in the string is not supported. With the * the file path has become unvalid.

    The AppPath variable is actually defined for a second time by the second orange line is where it retrieves the program path of AcroRd32.exe from registry.

    Basically the the first orange line is in most cases fully redundant.

    /Rems

    Avatar
    Shazam
    Member
    #318963

    Re: Need Help to Modify Pinning Shortcut VBScript

    Rems;290107 wrote:
    Wildcards in the string is not supported. With the * the file path has become unvalid.

    The AppPath variable is actually defined for a second time by the second orange line is where it retrieves the program path of AcroRd32.exe from registry.

    Basically the the first orange line is in most cases fully redundant.

    /Rems

    Thanks!

    Once again thank you so much for your help.

    Avatar
    Shazam
    Member
    #318966

    Hi,
    Can the code be modified to work with Windows 10?

    Any help?

    Avatar
    wullieb1
    Moderator
    #245465

    Have you tried running it on a Windows 10 PC??

    What happens??

    Avatar
    Shazam
    Member
    #318967
    wullieb1;n506233 wrote:
    Have you tried running it on a Windows 10 PC??

    What happens??

    Yes. I ran it and nothing happens. I’ve been researching online and it seems other scripts like powershell is also having this problem.

Viewing 8 posts - 1 through 8 (of 8 total)

You must be logged in to reply to this topic.