☰

VBScript 用于删除/固定 Windows 7 开始菜单的项目

tag-icon • tag-icon windows-7 microsoft-office office365 vbscript
VBScript 用于删除/固定 Windows 7 开始菜单的项目

我绞尽脑汁想解决这个问题。我目前正在将大约 600 台客户端计算机从 2013 版升级到 Office 365 Pro Plus 2016 版。我通过自动化软件进行此操作。这很有效！我正在努力删除当前 2013 版固定项目并固定 2016 版快捷方式。要求用户手动执行此操作也不是一种选择，因为我已将机器牢牢锁定，因此他们无法右键单击开始菜单项。我在 MS 论坛上找到了以下 VBScript。我已将其修改为我认为“应该”可以工作的内容，但它却不起作用。运行脚本时也没有错误。

'=-=-=-=-=-=-=-=-=-=-=-=-=
 '           CONSTS
 '=-=-=-=-=-=-=-=-=-=-=-=-=
 Const HKEY_CLASSES_ROOT     = &H80000000
 Const HKEY_CURRENT_USER     = &H80000001
 Const HKEY_LOCAL_MACHINE     = &H80000002
 Const HKEY_USERS             = &H80000003
 Const HKEY_CURRENT_CONFIG     = &H80000005

 Const CSIDL_COMMON_PROGRAMS    = &H17 
 Const CSIDL_PROGRAMS        = &H2 

 '=-=-=-=-=-=-=-=-=-=-=-=-=
 '          OBJECTS
 '=-=-=-=-=-=-=-=-=-=-=-=-=
 Set objRegistry            = GetObject("winmgmts:\\.\root\default:StdRegProv")
 Set objFSO                = CreateObject("Scripting.FileSystemObject")
 Set objApplication        = CreateObject("Shell.Application") 
 Set objAllUsersPrograms    = objApplication.NameSpace(CSIDL_COMMON_PROGRAMS)
 Set objUserPrograms        = objApplication.NameSpace(CSIDL_PROGRAMS)

 '=-=-=-=-=-=-=-=-=-=-=-=-=
 '          VARIABLES
 '=-=-=-=-=-=-=-=-=-=-=-=-=
 Dim arrSubValues, arrDeleteApps, arrPinApps, strAllUsersProgramsPath

 strAllUsersProgramsPath    = objAllUsersPrograms.Self.Path & "\"
 strUserProgramsPath        = objUserPrograms.Self.Path & "\"
 arrDeleteApps            = Array("displayswitch.lnk", "remote desktop connection.lnk", "sticky notes.lnk", "calculator.lnk", "paint.lnk", "xps viewer.lnk", "windows fax and scan.lnk")

 Call Main

 Sub Main()
     DeleteStartMenuApps HKEY_CURRENT_USER, "", arrDeleteApps

        DoVerb "Unpin from Start Menu", strAllUsersProgramsPath & "Microsoft Office 2013\Word 2013.lnk"
        DoVerb "Unpin from Start Menu", strAllUsersProgramsPath & "Microsoft Office 2013\Excel 2013.lnk"
    DoVerb "Unpin from Start Menu", strAllUsersProgramsPath & "Microsoft Office 2013\PowerPoint 2013.lnk"
        DoVerb "Unpin from Start Menu", strAllUsersProgramsPath & "Microsoft Office 2013\Outlook 2013.lnk"
        DoVerb "Pin to Start Menu", strUserProgramsPath & "Internet Explorer.lnk"
        DoVerb "Pin to Start Menu", strAllUsersProgramsPath & "Programs\Word 2016.lnk"
        DoVerb "Pin to Start Menu", strAllUsersProgramsPath & "Programs\Excel 2016.lnk"
    DoVerb "Pin to Start Menu", strAllUsersProgramsPath & "Programs\PowerPoint 2016.lnk"
        DoVerb "Pin to Start Menu", strAllUsersProgramsPath & "Programs\Outlook 2016.lnk"
    DoVerb "Pin to Start Menu", strAllUsersProgramsPath & "Accessories\Snipping Tool.lnk"
 End Sub


 '=-=-=-=-=-=-=-=-=-=-=-=-=
 '     FUNCTIONS AND SUBS
 '=-=-=-=-=-=-=-=-=-=-=-=-=
 Function DoVerb(strVerb, strPath)
     On Error Resume Next
         strFolder    = objFSO.GetParentFolderName(strPath)
         strFile        = objFSO.GetFileName(strPath)

         Set objFolder        = objApplication.NameSpace(strFolder)
         Set objFolderItem    = objFolder.ParseName(strFile)

         For Each ItemVerb In objFolderItem.Verbs
             If StrComp(Replace(ItemVerb.Name, "&", ""), strVerb, vbTextCompare) = 0 Then 
                 ItemVerb.DoIt
                 Exit Function
             End If
         Next
     On Error Goto 0
 End Function

 Sub DeleteStartMenuApps(hDefKey, sSubKeyUser, arrDeleteApps)
     If Len(sSubKeyUser) > 0 Then
         sSubKeyName = sSubKeyUser & "\Software\Microsoft\Windows\CurrentVersion\Explorer\UserAssist"
     Else
         sSubKeyName = "Software\Microsoft\Windows\CurrentVersion\Explorer\UserAssist"
     End If    

     objRegistry.EnumKey hDefKey, sSubKeyName, arrSubKeys

     If IsArray(arrSubKeys) Then
         For i = 0 to UBound(arrSubKeys)
             sTempSubKeyName = sSubKeyName & "\" & arrSubKeys(i) & "\Count"
             objRegistry.EnumValues hDefKey, sTempSubKeyName, arrSubValues

             If IsArray(arrSubValues) Then
                 For m = 0 to UBound(arrSubValues)
                     For n = 0 to UBound(arrDeleteApps)
                         If InStr(UCase(RunROT13(arrSubValues(m))), UCase(arrDeleteApps(n))) > 0 Then
                             objRegistry.DeleteValue hDefKey, sTempSubKeyName, arrSubValues(m)
                         End If
                     Next
                 Next
             End If
         Next
     End If
 End Sub


 Function RunROT13(strInput)
     For i = 1 to Len(strInput)
         iChr = Asc(Mid(strInput, i, 1))
         If (iChr >= 65 and iChr <= 77) Or (iChr >= 97 and iChr <= 109) Then 
             strOutput = strOutput & Chr(iChr +13)
         ElseIf (iChr >= 78 and iChr <= 90) Or (iChr >= 110 and iChr <= 122) Then 
             strOutput = strOutput & Chr(iChr -13) 
         Else
             strOutput = strOutput & Chr(iChr)
         End If
     Next

     RunROT13 = strOutput
 End Function

 Function IsProgramInstalled(objRegistry, strProgramDisplayName)
     intRegistryHive    = HKEY_LOCAL_MACHINE
     strRegistryKey    = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"

     objRegistry.EnumKey intRegistryHive, strRegistryKey, arrSubkeys

     IsProgramInstalled = FALSE

     For Each strSubkey In arrSubkeys
         strDisplayName = ReadRegistryValue(objRegistry, "STRING", intRegistryHive, strRegistryKey & "\" & strSubkey, "DisplayName")

         If UCase(strDisplayName) = UCase(strProgramDisplayName) Then
             IsProgramInstalled = TRUE
             Exit For
         End If
     Next
 End Function

 Function ReadRegistryValue(objRegistry, strType, intRegistryHive, strSubKeyName, sValueName)
     Select Case UCase(strType)
         Case "DWORD"
             objRegistry.GetDWORDValue intRegistryHive, strSubKeyName, sValueName, strValue
         Case "EXPANDEDSTRING"
             objRegistry.GetExpandedStringValue intRegistryHive, strSubKeyName, sValueName, strValue
         Case "MULTISTRING"
             objRegistry.GetMultiStringValue intRegistryHive, strSubKeyName, sValueName, strValue
         Case "STRING"
             objRegistry.GetStringValue intRegistryHive, strSubKeyName, sValueName, strValue
     End Select

     ReadRegistryValue = strValue
 End Function

任何帮助将非常感激！

答案1

运行脚本时也没有错误。

您需要删除这个并且永远不要再使用它：

On Error Resume Next

如果没有 On Error 语句，则发生的任何运行时错误都是致命的：会显示错误消息，并且执行停止。

相关内容