Eseguire l’aggiunta di applicazioni nella schermata Start di Windows 8 tramite script

Questo VBScript permette di eseguire in remoto l’aggiunta (pin) di applicazioni alla schermata Start di Windows 8. Infatti, a differenza della schermata “Tutte le App”, non è possibile eseguire l’aggiunta di applicazioni direttamente creando dei collegamenti in “C:\ProgramData\Microsoft\Windows\Start Menu” e “C:\Users\%Username%\AppData\Local\Microsoft\Windows\Menu Start\Programmi” tramite le Group Policy ( Microsoft TechNet- Configurare un elemento collegamento ) Il codice deriva dallo script presente in questa pagina Microsoft Script Center – Script to pin items to Start menu in Windows 8 (VBScript), ma si tratta di una versione adattata per i sistemi operativi in italiano e senza Message Box (che nella versione originale servono come pausa per l’esecuzione delle modifiche).

Script VBScript

Sub Main()
	' Array che contiene i percorsi delle applicazioni da aggiungere
	' In questo esempio alla schermata Start vengono aggiunti app1 e app2
	Dim elencoFile(2)
    	elencoFile(0) = "C:\app1.exe"
    	elencoFile(1) = "C:\app2.exe"
	Dim strFullPaths,strFullPath,FilePath,FileName
	Dim objShell,objFolder,objFolderItem,colVerbs
	Dim flag,i
	For i = 0 To  UBound(elencoFile) - 1
				strFullPath = elencoFile(i)
				FilePath = GetNameSpace(strFullPath)
				FileName = GetFileName(strFullPath)
				flag = 0
				Set objShell = CreateObject("Shell.Application")
				Set objFolder = objShell.Namespace(FilePath)
				Set objFolderItem = objFolder.ParseName(FileName)
				Set colVerbs = objFolderItem.Verbs
				Dim objVerb
				For Each objVerb in colVerbs
					If Replace(objVerb.name, "&", "") = "Aggiungi a Start" Then
					objVerb.DoIt
					Flag = 1
					End If
				Next
				' Esegue una pausa per permettere al sistema operativo di applicare la modifica
				WScript.sleep(2000)
			Next
End Sub 

' Restituisce il percorso di base del file
Function GetNameSpace(FullPath)
	Dim Position
	GetNameSpace = ""
	Position = InStrRev(FullPath, "\", -1, 1)
	If Position <> 0 Then GetNameSpace = Left(FullPath, Position)
End Function

' Restituisce il nome del file
Function GetFileName(FullPath)
	Dim Position
	Dim lngDotPosition
	Dim strFile
	GetFileName = ""
	Position = InStrRev(FullPath, "\", -1, 1)
	If Position <> 0 Then
		GetFileName = Right(FullPath, Len(FullPath) - Position)
	End If
End Function

Call Main
Taggato su: , ,

Lascia un commento

Il tuo indirizzo email non sarà pubblicato. I campi obbligatori sono contrassegnati *