[scripting] VBS Pin Shortcuts to Taskbar

[Marcum, John]

I have this script that works for pinning Office 2007 and 2010 shortcuts to the 
Windows 7 taskbar. I added in Office 2013 but it doesn't work. How would I 
troubleshoot this? Is it possible to somehow log the results of GetOfficeVer?


On Error Resume Next
Function GetOfficeVer()
On Error Resume Next
Dim ObjectWord,strVersiontemp
strVersiontemp = 0
Set ObjectWord = CreateObject("Word.Application")
strVersiontemp =  ObjectWord.Version
ObjectWord.Quit
Set ObjectWord = Nothing
GetOfficeVer = strVersiontemp

End Function


Const CSIDL_COMMON_PROGRAMS = &H17
Const CSIDL_PROGRAMS = &H2
Set objShell = CreateObject("Shell.Application")
Set objAllUsersProgramsFolder = objShell.NameSpace(CSIDL_COMMON_PROGRAMS)
strAllUsersProgramsPath = objAllUsersProgramsFolder.Self.Path

Set objACCFolder = objShell.Namespace(strAllUsersProgramsPath & "\Accessories")
Set objOFFFolder = objShell.Namespace(strAllUsersProgramsPath & "\Microsoft 
Office")
Set objRootFolder = objShell.Namespace(strAllUsersProgramsPath & "\")
If GetOfficeVer = "12.0" then

Set objRootFolder2 = objRootFolder.ParseName("Windows Media Player.lnk")
Set colROOTVerbs2 = objRootFolder2.Verbs
For Each objVerb in colROOTVerbs2
    If Replace(objVerb.name, "&", "") = "Unpin this program from taskbar" Then 
objVerb.DoIt
Next
Set objOFFFolder1 = objOFFFolder.ParseName("Microsoft Office Outlook 2007.lnk")
Set colOFFVerbs1 = objOFFFolder1.Verbs
For Each objVerb in colOFFVerbs1
    If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
Next
Set objOFFFolder1 = objOFFFolder.ParseName("Microsoft Office Word 2007.lnk")
Set colOFFVerbs1 = objOFFFolder1.Verbs
For Each objVerb in colOFFVerbs1
    If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
Next
Set objOFFFolder1 = objOFFFolder.ParseName("Microsoft Office Excel 2007.lnk")
Set colOFFVerbs1 = objOFFFolder1.Verbs
For Each objVerb in colOFFVerbs1
    If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
Next
End if

If GetOfficeVer = "13.0" then



Set objRootFolder2 = objRootFolder.ParseName("Windows Media Player.lnk")
Set colROOTVerbs2 = objRootFolder2.Verbs
For Each objVerb in colROOTVerbs2
    If Replace(objVerb.name, "&", "") = "Unpin this program from taskbar" Then 
objVerb.DoIt
Next
Set objOFFFolder1 = objOFFFolder.ParseName("Microsoft Outlook 2010.lnk")
Set colOFFVerbs1 = objOFFFolder1.Verbs
For Each objVerb in colOFFVerbs1
    If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
Next
Set objOFFFolder1 = objOFFFolder.ParseName("Microsoft Word 2010.lnk")
Set colOFFVerbs1 = objOFFFolder1.Verbs
For Each objVerb in colOFFVerbs1
    If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
Next
Set objOFFFolder1 = objOFFFolder.ParseName("Microsoft Excel 2010.lnk")
Set colOFFVerbs1 = objOFFFolder1.Verbs
For Each objVerb in colOFFVerbs1
    If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
Next
End if


If GetOfficeVer = "15.0" then



Set objRootFolder2 = objRootFolder.ParseName("Windows Media Player.lnk")
Set colROOTVerbs2 = objRootFolder2.Verbs
For Each objVerb in colROOTVerbs2
    If Replace(objVerb.name, "&", "") = "Unpin this program from taskbar" Then 
objVerb.DoIt
Next
Set objOFFFolder1 = objOFFFolder.ParseName("Microsoft Outlook 2013.lnk")
Set colOFFVerbs1 = objOFFFolder1.Verbs
For Each objVerb in colOFFVerbs1
    If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
Next
Set objOFFFolder1 = objOFFFolder.ParseName("Microsoft Word 2013.lnk")
Set colOFFVerbs1 = objOFFFolder1.Verbs
For Each objVerb in colOFFVerbs1
    If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
Next
Set objOFFFolder1 = objOFFFolder.ParseName("Microsoft Excel 2013.lnk")
Set colOFFVerbs1 = objOFFFolder1.Verbs
For Each objVerb in colOFFVerbs1
    If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
Next
End if


________________________________
        John Marcum
            MCITP, MCTS, MCSA
           Sr. Desktop Architect
   Bradley Arant Boult Cummings LLP
________________________________
      [H_Logo]


________________________________

Confidentiality Notice: This e-mail is from a law firm and may be protected by 
the attorney-client or work product privileges. If you have received this 
message in error, please notify the sender by replying to this e-mail and then 
delete it from your computer.

<<inline: image001.png>>