Set Windows Wallpaper, IE Homepage and Colors via VBScript

This script sets the user's IE homepage, background wallpaper and color scheme via the registry. I used it to control the wallpaper company wide. Each division has it's own logo, so I used the user's DN (Distinguished Name) in Active Directory to look for specified OUs that would be used to determine what wallpaper they should have.

The wallpaper image file would be copied to their local drive and the path is saved as a variable to be written to the registry. The background color is also modified (to my company's logo color) and the homepage is set.

I have left a single example in for reference. The example looks for the "Admin Staff" OU to be listed.

The LDAP query will obviously need to be modified to match your domain controller.

'Author: Christopher Maddalena
'Date: November 14, 2007
'How: The user's distinguished name is pulled from AD and searched for specific
'OUs. Registry keys are altered using WScript.Shell
'to change the background colors and wallpaper image.
Option Explicit
Call Main()

On Error Resume Next

Sub Main
Const HKCU = &H80000001
Const HKUSER = &H80000003

Dim objShell, objFileSystem, objFileCopy, objSrcFile, objADSystemInfo, objUser, objCommand, objConnection, objRootDSE, objRecordSet, objNetwork, objRegistry
Dim strRegLocate, strWallpaperPath, strCopyPath, strDNSDomain, strstrFilter, strAttributes, strQuery, strUserName, strDN, dwValue, strRegPath, strKey, strComputer

Set objShell = WScript.CreateObject("WScript.Shell")
Set objFileSystem = CreateObject("Scripting.FileSystemobject")
Set objNetwork = CreateObject("WScript.Network")

strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection

objCommand.Properties("Page Size") = 1000

'Pull the username for the query
strUserName = objNetwork.UserName

'Query the user's distinguishedName from AD
objCommand.CommandText = "SELECT distinguishedName FROM 'LDAP://dc=AD,dc=AD,dc=AD' WHERE objectCategory='user' " & _
"AND sAMAccountName='" & strUserName & "'"

Set objRecordSet = objCommand.Execute

strCopyPath = objShell.ExpandEnvironmentStrings("%programfiles%") & "\FOLDER\"

strDN = objRecordSet.Fields("distinguishedName").Value

'Test function - Applies to the Admin Staff OU
'If InStr(strDN,"Admin Staff") Then
'Set objSrcFile = objFilesystem.GetFile("\\FILE_PATH\WALLPAPER.JPG")

'objFileSystem.CopyFile objSrcFile.Path, strCopyPath

'strWallpaperPath = strCopyPath & "WALLPAPER.JPG"
'End If

'Set the user's homepage
'strRegLocate = "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Internet Explorer\Main\Start Page"
'objShell.RegWrite strRegLocate,"WEBSITE", "REG_SZ"

'Set the user's wallpaper
strRegLocate = "HKEY_CURRENT_USER\Control Panel\Desktop\Wallpaper"
objShell.RegWrite strRegLocate, strWallpaperPath

'Set the wallpaper style (centered)
strRegLocate = "HKEY_CURRENT_USER\Control Panel\Desktop\WallpaperStyle"
objShell.RegWrite strRegLocate, "0", "REG_SZ"

'Set the background color
strRegPath = "Control Panel\Colors\"
strKey = "Background"
objRegistry.GetStringValue HKCU,strRegPath,strKey,dwValue
strRegLocate = "HKEY_CURRENT_USER\Control Panel\Colors\Background"
'If not already the correct color, change it
If dwValue <> "0 34 79" Then
objShell.RegWrite strRegLocate,"0 34 79", "REG_SZ"
End If

'strRegLocate = "HKEY_USERS\.DEFAULT\Control Panel\Colors\Background"
'objShell.RegWrite strRegLocate,"0 34 79", "REG_SZ"

'Save the changes
objShell.Run "%windir%\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End Sub


Morris Viderhorn said...
This comment has been removed by the author.
Morris Viderhorn said...

Hello Chris,

I loved the script, maybe you can help me modify my script? I'm trying to change users wallpaper with my company logo and it should be in the center with blue background.

I can't figure out how to make the logo in the center with blue background.

Here is my script:

Option Explicit
Dim WshShell, strValue, sleepTime, oFSO

strValue = "C:\companylogo.jpg"
sleepTime = 30000

Set oFSO = CreateObject("Scripting.FileSystemObject")
oFSO.CopyFile "\\FILE1\shares\desktop\companylogo.jpg", "C:\"

Set WshShell = WScript.CreateObject("Wscript.Shell")
WshShell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", strValue
WScript.Sleep sleepTime
WshShell.Run "%windir%\System32\RUNDLL32.EXE user32.dll, UpdatePerUserSystemParameters", 1, True

Set WshShell = Nothing

Any help will really be great.