J House Consulting

I wrote this script to help a customer clean up old orphaned and stale printer objects from user profiles. This script can safely be executed in each user session and works a treat.

However, you may first want to try my script to remove printers the traditional way.

Enjoy!

Option Explicit

' This script will remove registry keys and values. It was specifically written to clean out
' old orphaned/stale printer objects from a users registry hive that cannot be removed using
' the conventional methods.
' If any registry key or value contains the strings listed in the arrOrphanedPrinters array,
' it will be removed.

' This script could easily be modified to rename printer objects.

' Written by Jeremy@jhouseconsulting.com on 28th July 2008.

' Note that the RegValueExists and RegKeyExists functions were written by torgeir, a Microsoft
' MVP in Scripting and WMI. They were made freely available on the Internet.

Dim arrOrphanedPrinters, strComputer, strKeyRoot, strKeyPath, objRegistry, arrSubkeys
Dim strSubkey, return, BlnReturn

arrOrphanedPrinters = Array("iprint","printing")

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

strKeyRoot = "HKCU\"
strKeyPath = "Printers\Connections"
If RegKeyExists(strKeyRoot & strKeyPath) Then
  return = objRegistry.EnumKey (HKEY_CURRENT_USER, strKeyPath, arrSubkeys)
  If return=0 and IsArray(arrSubkeys) Then
    For Each strSubkey In arrSubkeys
      BlnReturn=InArray(strSubkey,arrOrphanedPrinters)
      If BlnReturn Then
          DeleteSubkeys HKEY_CURRENT_USER, strKeyPath & "\" & strSubkey
      End If
    Next
  End If
End If

strKeyRoot = "HKCU\"
strKeyPath = "Printers\DevModePerUser"
If RegKeyExists(strKeyRoot & strKeyPath) Then
'  wscript.echo strKeyRoot & strKeyPath & " exists."
  Call DeleteValues(strKeyRoot,strKeyPath)
End If

strKeyRoot = "HKCU\"
strKeyPath = "Printers\DevModes2"
If RegKeyExists(strKeyRoot & strKeyPath) Then
'  wscript.echo strKeyRoot & strKeyPath & " exists."
  Call DeleteValues(strKeyRoot,strKeyPath)
End If

strKeyRoot = "HKCU\"
strKeyPath = "Printers\Settings"
If RegKeyExists(strKeyRoot & strKeyPath) Then
'  wscript.echo strKeyRoot & strKeyPath & " exists."
  Call DeleteValues(strKeyRoot,strKeyPath)
End If

Set objRegistry = Nothing

wscript.quit(0)

Sub DeleteSubkeys(HKEY_CURRENT_USER, strKeyPath)
  objRegistry.EnumKey HKEY_CURRENT_USER, strKeyPath, arrSubkeys
  If IsArray(arrSubkeys) Then
    For Each strSubkey In arrSubkeys
      DeleteSubkeys HKEY_CURRENT_USER, strKeyPath & "\" & strSubkey
    Next
  End If
  objRegistry.DeleteKey HKEY_CURRENT_USER, strKeyPath
End Sub

Sub DeleteValues(strKeyRoot,strKeyPath)
  Dim i, arrValueNames, arrValueTypes, return, BlnReturn
  return = objRegistry.EnumValues (HKEY_CURRENT_USER, strKeyPath,_
    arrValueNames, arrValueTypes)
  If return=0 and IsArray(arrValueNames) Then
    For i=0 To UBound(arrValueNames)
      BlnReturn=InArray(arrValueNames(i),arrOrphanedPrinters)
        If BlnReturn Then
          objRegistry.DeleteValue HKEY_CURRENT_USER, strKeyPath, arrValueNames(i)
      End If
    Next
  End If
End Sub

Function RegValueExists(sRegValue)
' Returns True or False based of the existence of a registry value.
  Dim oShell, RegReadReturn
  Set oShell = CreateObject("WScript.Shell")
  RegValueExists = True  ' init value
  On Error Resume Next
  RegReadReturn = oShell.RegRead(sRegValue)
  If Err.Number <> 0 Then
    RegValueExists = False
  End if
  On Error Goto 0
  Set oShell = Nothing
End Function

Function RegKeyExists(ByVal sRegKey)
' Returns True or False based on the existence of a registry key.
  Dim sDescription, oShell
  Set oShell = CreateObject("WScript.Shell")
  RegKeyExists = True
  sRegKey = Trim (sRegKey)
  If Not Right(sRegKey, 1) = "\" Then
    sRegKey = sRegKey & "\"
  End If
  On Error Resume Next
  oShell.RegRead "HKEYNotAKey\"
  sDescription = Replace(Err.Description, "HKEYNotAKey\", "")
  Err.Clear
  oShell.RegRead sRegKey
  RegKeyExists = sDescription <> Replace(Err.Description, sRegKey, "")
  On Error Goto 0
  Set oShell = Nothing
End Function

Function InArray(item,myarray)
  Dim i
  For i=0 To UBound(myarray) Step 1
    If instr(lcase(item),lcase(myarray(i))) Then
      InArray=True
      Exit Function
    End If
  Next
  InArray=False
End Function