Link to home
Start Free TrialLog in
Avatar of kpiller
kpillerFlag for United States of America

asked on

VB script to find and replace registry values

Hello,
I need a VB script that can find and replace string values in windows registry. I'd like to specify the key to search in.
Have been using regfind batch scipt but it is giving me issue with some registry keys.
Thank you!
Avatar of Jon_Harvey
Jon_Harvey
Flag of United States of America image

Requires WMI and some talent in VBScript. Here is a site that has lots of code:
http://www.activexperts.com/activmonitor/windowsmanagement/adminscripts/registry/
Avatar of kpiller

ASKER

None of those scripts seem to do what I need or can't tell which ones I could put together to accomplish what I need to.
Avatar of RobSampson
Hi, here's a start, which will search the current specified key only, and will only display the path found, not change it....

Here's some references:
http://msdn2.microsoft.com/en-us/library/aa390387(VS.85).aspx
http://msdn2.microsoft.com/en-us/library/aa390388.aspx
http://msdn2.microsoft.com/en-us/library/aa393664(VS.85).aspx
http://msdn2.microsoft.com/en-us/library/3kfz157h(VS.85).aspx

Regards,

Rob.
' Duplicate these to account for each abbreviation
Const HKCR = &H80000000
Const HKEY_CLASSES_ROOT = &H80000000
Const HKCU = &H80000001
Const HKEY_CURRENT_USER = &H80000001
Const HKLM = &H80000002
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKUSERS = &H80000003
Const HKEY_USERS = &H80000003
Const HKCC = &H80000005
Const HKEY_CURRENT_CONFIG = &H80000005
 
'Value types
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
 
strComputer = "."
 
Set objRegistry=GetObject("winmgmts:\\" & _ 
    strComputer & "\root\default:StdRegProv")
 
strKeyPath = InputBox("Please enter the full key to search in: ", "Key to Search", "HKCU\Volatile Environment")
strRoot = UCase(Left(strKeyPath, InStr(strKeyPath, "\") - 1))
strKeyPath = Mid(strKeyPath, InStr(strKeyPath, "\") + 1)
 
strValueToFind = InputBox("Please enter the value to search for: ", "Value to Find", "TestValueHere")
 
Select Case strRoot
	Case "HKCR", "HKEY_CLASSES_ROOT"
		strRootKey = HKCR
	Case "HKCU", "HKEY_CURRENT_USER"
		strRootKey = HKCU
	Case "HKLM", "HKEY_LOCAL_MACHINE"
		strRootKey = HKLM
	Case "HKUSERS", "HKEY_USERS"
		strRootKey = HKUSERS
	Case "HKCC", "HKEY_CURRENT_CONFIG"
		strRootKey = HKCC
	Case Else
		MsgBox "Invalid root key entered."
		WScript.Quit
End Select
 
strFoundPath = SearchValues(strRootKey, strKeyPath, strValueToFind)
 
If strFoundPath = "" Then
	MsgBox "Value not found."
Else
	MsgBox strValueToFind & " was found at" & VbCrLf & _
		strRoot & "\" & Split(strFoundPath, "|<>|")(0) & VbCrLf & _
		"Value Type: " & Split(strFoundPath, "|<>|")(1)
End If
 
Function SearchValues(strRoot, strPath, strFind)
	strFoundAt = ""
	strType = ""
	objRegistry.EnumValues strRoot, strPath, arrValueNames, arrValueTypes
	For intVal = LBound(arrValueNames) To UBound(arrValueNames)
	    Select Case arrValueTypes(intVal)
			Case REG_SZ
				If VarType(strFind) = vbString Then
					objRegistry.GetStringValue strRoot, strPath, arrValueNames(intVal), strValue
					If strValue = strFind Then
						strFoundAt = strPath & "\" & arrValueNames(intVal)
						strType = "String"
					End If
				End If
			Case REG_EXPAND_SZ
				If VarType(strFind) = vbString Then
					objRegistry.GetExpandedStringValue strRoot, strPath, arrValueNames(intVal), strValue
					If strValue = strFind Then
						strFoundAt = strPath & "\" & arrValueNames(intVal)
						strType = "ExpandedString"
					End If
				End If
			Case REG_BINARY
				If VarType(strFind) = vbByte Then
					objRegistry.GetBinaryValue strRoot, strPath, arrValueNames(intVal), strValue
					If strValue = strFind Then
						strFoundAt = strPath & "\" & arrValueNames(intVal)
						strType = "Binary"
					End If
				End If
			Case REG_DWORD
				If VarType(strFind) = vbString Then
					objRegistry.GetDWordValue strRoot, strPath, arrValueNames(intVal), strValue
					If strValue = strFind Then
						strFoundAt = strPath & "\" & arrValueNames(intVal)
						strType = "DWord"
					End If
				End If
			Case REG_MULTI_SZ
				If VarType(strFind) = vbString Then
					objRegistry.GetMultiStringValue strRoot, strPath, arrValueNames(intVal), arrValues
					For Each strValue In arrValues
						If strValue = strFind Then
							strFoundAt = strPath & "\" & arrValueNames(intVal)
							strType = "MultiString"
						End If
					Next
				End If
		End Select
	Next
	If strFoundAt <> "" Then
		SearchValues = strFoundAt & "|<>|" & strType
	Else
		SearchValues = ""
	End If
End Function
 
'Function SearchKeys(strRoot, strPath, strFind)
'	objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubkeys
'	For Each objSubkey In arrSubkeys
'	    strValueName = "ProfileImagePath"
'	    strSubPath = strKeyPath & "\" & objSubkey
'	    objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE,strSubPath,strValueName,strValue
'	    Wscript.Echo strValue
'	Next
'End Function

Open in new window

Avatar of kpiller

ASKER

Thanks, I can't see how that is going to solve this for me.

The keys the string value is in I need to be changed could be named anything and this is on about 250 workstations.

I would have to run it on every workstation and then build a script for each individual workstation to modify the keys in question.

The values to change are in a printer key and the key will just be what ever the printer was named when installed on each workstation which will vary greatly.
I really just need to do a search and replace.
Thanks
It should still help though.....strValueToFind could still be populated dynamically, and once I put in a SubKey search, you could specify a faily safe parent key and it would search down that tree....

I'll try it shortly.....

Regards,

Rob.
Try this.  No guarantees or warranties of any kind......remember you're playing with the registry....back it up first!

I have tested it on the keys that you see in the input boxes....

Regards,

Rob.
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If
 
' Duplicate these to account for each abbreviation
Const HKCR = &H80000000
Const HKEY_CLASSES_ROOT = &H80000000
Const HKCU = &H80000001
Const HKEY_CURRENT_USER = &H80000001
Const HKLM = &H80000002
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKUSERS = &H80000003
Const HKEY_USERS = &H80000003
Const HKCC = &H80000005
Const HKEY_CURRENT_CONFIG = &H80000005
 
'Value types
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
 
strComputer = "."
 
Set objRegistry=GetObject("winmgmts:\\" & _ 
    strComputer & "\root\default:StdRegProv")
 
strKeyPath = InputBox("Please enter the full key to search in: ", "Key to Search", "HKCU\Software")
If Right(strKeyPath, 1) = "\" Then strKeyPath = Left(strKeyPath, Len(strKeyPath) - 1)
strRoot = UCase(Left(strKeyPath, InStr(strKeyPath, "\") - 1))
strKeyPath = Mid(strKeyPath, InStr(strKeyPath, "\") + 1)
 
strValueToFind = InputBox("Please enter the value to search for: ", "Value to Find", "TestValueHere")
 
strReplaceWith = InputBox("Please enter the value to replace this with: ", "Value to Replace With", "TestValueChanged")
 
Select Case strRoot
	Case "HKCR", "HKEY_CLASSES_ROOT"
		strRootKey = HKCR
	Case "HKCU", "HKEY_CURRENT_USER"
		strRootKey = HKCU
	Case "HKLM", "HKEY_LOCAL_MACHINE"
		strRootKey = HKLM
	Case "HKUSERS", "HKEY_USERS"
		strRootKey = HKUSERS
	Case "HKCC", "HKEY_CURRENT_CONFIG"
		strRootKey = HKCC
	Case Else
		MsgBox "Invalid root key entered."
		WScript.Quit
End Select
 
strFoundAt = ""
 
SearchKeys strRootKey, strKeyPath, strValueToFind
 
WScript.Echo
 
If strFoundAt = "" Then
	WScript.Echo "Value not found."
Else
	strFoundPath = strRoot & "\" & Split(strFoundAt, "|<>|")(0)
	strValueType = Split(strFoundAt, "|<>|")(1)
	Wscript.Echo strValueToFind & " was found at" & VbCrLf & _
		strFoundPath & VbCrLf & _
		"Value Type: " & strValueType & VbCrLf
	WScript.StdOut.Write "Are you sure you want to change this value to " & strReplaceWith & "? (Y/N): "
	strResponse = WScript.StdIn.ReadLine
	If Len(strResponse) > 0 Then
		If Left(UCase(strResponse), 1) = "Y" Then
			intResponse = ChangeValue(strRootKey, Mid(strFoundPath, InStr(strFoundPath, "\") + 1), strValueType, strReplaceWith)
			If intResponse = 0 Then
				WScript.Echo "Changed from " & strValueToFind & " to " & strReplaceWith
			Else
				WScript.Echo "Failed to change from " & strValueToFind & " to " & strReplaceWith
			End If
		Else
			WScript.Echo "Value not changed."
		End If
	Else
		WScript.Echo "Value not changed."
	End If
End If
 
Function ChangeValue(strRootPath, strPath, strType, strReplacement)
	strKey = Left(strPath, InStrRev(strPath, "\") - 1)
	strValue = Mid(strPath, InStrRev(strPath, "\") + 1)
	Select Case strType
		Case "String"
			On Error Resume Next
			intReturn = objRegistry.SetStringValue(strRootPath, strKey, strValue, strReplacement)
			Err.Clear
			On Error GoTo 0
		Case "ExpandedString"
			On Error Resume Next
			intReturn = objRegistry.SetExpandedStringValue(strRootPath, strKey, strValue, strReplacement)
			Err.Clear
			On Error GoTo 0
		Case "Binary"
			On Error Resume Next
			intReturn = objRegistry.SetBinaryValue(strRootPath, strKey, strValue, strReplacement)
			Err.Clear
			On Error GoTo 0
		Case "DWord"
			On Error Resume Next
			intReturn = objRegistry.SetDWORDValue(strRootPath, strKey, strValue, strReplacement)
			Err.Clear
			On Error GoTo 0
		Case "MultiString"
			On Error Resume Next
			intReturn = objRegistry.SetMultiStringValue(strRootPath, strKey, strValue, Array(strReplacement))
			Err.Clear
			On Error GoTo 0
	End Select
	ChangeValue = intReturn
End Function
 
Sub SearchKeys(strRootPath, strPath, strFind)
	'strFoundAt = ""
	strFoundAt = SearchValues(strRootPath, strPath, strFind)
	If strFoundAt = "" Then
		objRegistry.EnumKey strRootPath, strPath, arrSubkeys
		If TypeName(arrSubkeys) <> "Null" Then
			For Each objSubkey In arrSubkeys
				WScript.Echo strPath & "\" & objSubKey
				SearchKeys strRootPath, strPath & "\" & objSubKey, strFind
				If strFoundAt <> "" Then Exit For
			Next
		End If
	Else
		'SearchKeys = strFoundAt
		Exit Sub
	End If
End Sub
 
Function SearchValues(strRootPath, strPath, strFind)
	'strFoundAt = ""
	strType = ""
	objRegistry.EnumValues strRootPath, strPath, arrValueNames, arrValueTypes
	If TypeName(arrValueNames) <> "Null" Then
		For intVal = LBound(arrValueNames) To UBound(arrValueNames)
		    Select Case arrValueTypes(intVal)
				Case REG_SZ
					If VarType(strFind) = vbString Then
						objRegistry.GetStringValue strRootPath, strPath, arrValueNames(intVal), strValue
						If strValue = strFind Then
							strFoundAt = strPath & "\" & arrValueNames(intVal)
							strType = "String"
						End If
					End If
				Case REG_EXPAND_SZ
					If VarType(strFind) = vbString Then
						objRegistry.GetExpandedStringValue strRootPath, strPath, arrValueNames(intVal), strValue
						If strValue = strFind Then
							strFoundAt = strPath & "\" & arrValueNames(intVal)
							strType = "ExpandedString"
						End If
					End If
				Case REG_BINARY
					If VarType(strFind) = vbByte Then
						objRegistry.GetBinaryValue strRootPath, strPath, arrValueNames(intVal), strValue
						If strValue = strFind Then
							strFoundAt = strPath & "\" & arrValueNames(intVal)
							strType = "Binary"
						End If
					End If
				Case REG_DWORD
					If VarType(strFind) = vbString Then
						objRegistry.GetDWordValue strRootPath, strPath, arrValueNames(intVal), strValue
						If strValue = strFind Then
							strFoundAt = strPath & "\" & arrValueNames(intVal)
							strType = "DWord"
						End If
					End If
				Case REG_MULTI_SZ
					If VarType(strFind) = vbString Then
						objRegistry.GetMultiStringValue strRootPath, strPath, arrValueNames(intVal), arrValues
						For Each strValue In arrValues
							If strValue = strFind Then
								strFoundAt = strPath & "\" & arrValueNames(intVal)
								strType = "MultiString"
							End If
						Next
					End If
			End Select
			If strFoundAt <> "" Then Exit For
		Next
	End If
	If strFoundAt <> "" Then
		SearchValues = strFoundAt & "|<>|" & strType
	Else
		SearchValues = ""
	End If
End Function

Open in new window

Avatar of kpiller

ASKER

This worked! Thank you very much.
Could you help me simplify it a little for my needs, would be much appreciated.

1. I do not need it to run a command window or have any prompts at all, would just like it to do its thing silently. I would just manually enter the string seach and replace values in the script.

2. If it could do a replace all type of thing so it did not stop on the first entry it found, if it could go through and change all that if found.

3. Also I would like to be able to have it do multiple search and replaces, probably just repeat that part of the code over and over for however many I want to enter.

I tried on my own and got a small amount of that done but my VB skills are proving to be pretty much non-existent.

The only key I need to search in is:
HKLM\SYSTEM\ControlSet001\Control\Print\Printers
So it is not searching much but there will be multiple values I need to change.

Thanks again very much for your help
ASKER CERTIFIED SOLUTION
Avatar of RobSampson
RobSampson
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of kpiller

ASKER

That works great, thank you.
Avatar of kpiller

ASKER

Thanks again for your help.
No worries. Thanks for the grade.

Regards,

Rob.