No errors when running the script also.
Você precisa remover este e NUNCA usá-lo novamente:
On Error Resume Next
Without an On Error statement, any run-time error that occurs is fatal: an error message is displayed, and execution stops.
Estou batendo minha cabeça contra uma parede tentando descobrir isso. Estou atualmente no processo de atualização de cerca de 600 máquinas cliente para o Office 365 Pro Plus 2016 a partir de 2013. Estou fazendo isso por meio de um software de automação. Isso funciona muito bem! O que eu estou com dificuldades é remover os itens atuais fixados em 2013 e fixar os atalhos de 2016. Pedir aos usuários para fazer isso manualmente também não é uma opção, já que tenho as máquinas bloqueadas, então eles não podem clicar com o botão direito nos itens do menu Iniciar. Eu encontrei o seguinte VBScript em fóruns de MS. Eu alterei para o que eu acho que 'deveria' funcionar, mas isso não acontece. Nenhum erro ao executar o script também.
'=-=-=-=-=-=-=-=-=-=-=-=-=
' 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
Qualquer ajuda seria muito apreciada!
No errors when running the script also.
Você precisa remover este e NUNCA usá-lo novamente:
On Error Resume Next
Without an On Error statement, any run-time error that occurs is fatal: an error message is displayed, and execution stops.