VBScript удалить / закрепленные элементы в меню Пуск Windows 7

Я бьюсь головой об стену, пытаясь понять это. В настоящее время я занимаюсь обновлением около 600 клиентских компьютеров до Office 365 профессиональный плюс 2016 с 2013 года. Я делаю это с помощью программного обеспечения автоматизации. Это очарование! То, с чем я борюсь, - это удаление текущих закрепленных элементов 2013 года и закрепление ярлыков 2016 года. Просить пользователей сделать это вручную также не вариант, поскольку у меня есть машины, заблокированные плотно, поэтому они не могут щелкнуть правой кнопкой мыши по пунктам меню "Пуск".
Я нашел следующий 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:.rootdefault: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 2013Word 2013.lnk"
        DoVerb "Unpin from Start Menu", strAllUsersProgramsPath & "Microsoft Office 2013Excel 2013.lnk"
    DoVerb "Unpin from Start Menu", strAllUsersProgramsPath & "Microsoft Office 2013PowerPoint 2013.lnk"
        DoVerb "Unpin from Start Menu", strAllUsersProgramsPath & "Microsoft Office 2013Outlook 2013.lnk"
        DoVerb "Pin to Start Menu", strUserProgramsPath & "Internet Explorer.lnk"
        DoVerb "Pin to Start Menu", strAllUsersProgramsPath & "ProgramsWord 2016.lnk"
        DoVerb "Pin to Start Menu", strAllUsersProgramsPath & "ProgramsExcel 2016.lnk"
    DoVerb "Pin to Start Menu", strAllUsersProgramsPath & "ProgramsPowerPoint 2016.lnk"
        DoVerb "Pin to Start Menu", strAllUsersProgramsPath & "ProgramsOutlook 2016.lnk"
    DoVerb "Pin to Start Menu", strAllUsersProgramsPath & "AccessoriesSnipping 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 & "SoftwareMicrosoftWindowsCurrentVersionExplorerUserAssist"
     Else
         sSubKeyName = "SoftwareMicrosoftWindowsCurrentVersionExplorerUserAssist"
     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    = "SOFTWAREMicrosoftWindowsCurrentVersionUninstall"

     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

любая помощь будет действительно оценили!

21
задан duDE
22.11.2022 20:40 Количество просмотров материала 2466
Распечатать страницу

1 ответ

нет ошибок при запуске скрипта.

вам нужно удалить этот и никогда не использовать его снова:

On Error Resume Next

без оператора On Error любая возникающая во время выполнения ошибка фатальная ошибка: появляется сообщение об ошибке, и выполнение останавливается.

0
отвечен duDE 2022-11-24 04:28

Постоянная ссылка на данную страницу: [ Скопировать ссылку | Сгенерировать QR-код ]

Ваш ответ

Опубликуйте как Гость или авторизуйтесь

Имя

Похожие вопросы про тегам:

microsoft-office
office365
vbscript
windows-7
Вверх