The Mrs wanted a wallpaper changer, but the Powertoys one doesn’t work because she’s using a limited account and it tries to create the bmp file in a restricted directory.  So I made her one.  Don’t ask me how it works, it makes my head hurt to just look at its ugliness.  My VB is so rusty.

But it works. Just change to objStartFolder to your desired directory.


dim curImg
dim firstImg
dim flag
dim wp
dim startOver

objStartFolder = "D:\Photos\temp"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(objStartFolder)

Set colFiles = objFolder.Files
flag = false
startOver = true

strRegRoot = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Desktop\General\"
strRegRoot2 = "HKEY_CURRENT_USER\Control Panel\Desktop\"

Set Shell = WScript.CreateObject("Wscript.Shell")
curImg = Shell.RegRead(strRegRoot & "Wallpaper")
curImg = mid(curImg, InStrRev(curImg, "\")+1)

For Each o in colFiles
  fn = o.Name
  ext = mid(fn,InStrRev(fn,"."))

  if ext = ".bmp" then
     firstImg = fn
     exit for
  end if

Next

For Each o in colFiles
  fn = o.Name
  ext = mid(fn,InStrRev(fn,"."))

  if ext = ".bmp" then

    if flag = true then

        setWP(fn)
        startOver = false
        exit for

    end if

    if fn = curImg then
        flag = true
    end if

  end if 

Next

if startOver = true then
  setWP(firstImg)
end if

Set Shell = Nothing
Set objFolder = Nothing
Set objFSO = Nothing

Sub setWP(fn)
    wp = objStartFolder & "\" & fn

    Shell.RegWrite strRegRoot & "BackUpWallpaper", wp
    Shell.RegWrite strRegRoot & "Wallpaper", wp
    Shell.RegWrite strRegRoot2 & "Wallpaper", wp
    Shell.Run "%windir%\System32\RUNDLL32.EXE " & _
                "user32.dll,UpdatePerUserSystemParameters", 1, False

End Sub