Need Help to Modify Pinning Shortcut VBScript

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

Viewing 1 post (of 1 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?

Viewing 1 post (of 1 total)

You must be logged in to reply to this topic.