Skript na zmenu wallpaperu

Toz sharper chtela skript na nahodnou zmenu wallpaperu, ma ho mit:

Option Explicit

Const strWallpapersFolder = "E:\\_wallpapers\\"
 
Dim objFSO, objWF, objFile, objFiles
Dim arrWallpapers(), i
Dim intRnd
Dim objShell
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWF = objFSO.GetFolder(strWallpapersFolder)
Set objFiles = objWF.Files
i = 0
For Each objFile in objFiles
	If LCase(Right(objFile.name, 3)) = "bmp" Then
		i = i + 1
		redim preserve arrWallpapers(i)
		arrWallpapers(i) = objFile.name
	End If
Next

Randomize
intRnd = Int((i * Rnd) + 1)

Set objShell = WScript.CreateObject("Wscript.Shell")

objShell.RegWrite "HKCU\\Control Panel\\Desktop\\Wallpaper", strWallpapersFolder & arrWallPapers(intRnd)
objShell.Run "C:\\windows\\System32\\rundll32.exe user32.dll,UpdatePerUserSystemParameters", 1, False

redim arrWallpapers(0)
Set objShell = Nothing
Set objFile = Nothing
Set objFiles = Nothing
Set objWF = Nothing
Set objFSO = Nothing