list all keys, subkeys and values in registry hive

[westconn1]

here is a recursive scripting method to get all keys and subkeys in a hive starting from root or any level
takes a while, probably should have a doevents somewhere, to prevent computer lockup while running

Sub getsubkeys(hkey As Long, strpath As String, sk As Variant)
Dim strkeypath As String, subkey As Variant, arrsubkeys As Variant
strkeypath = strpath
If Not Len(sk) = 0 And Not Len(strpath) = 0 Then strkeypath = strpath & "\"
strkeypath = strkeypath & sk
oreg.EnumKey hkey, strkeypath, arrsubkeys
If Not IsNull(arrsubkeys) Then
For Each subkey In arrsubkeys
    Debug.Print strkeypath & "\" & subkey     ' or print to form or whatever
      ' for speed considerations should be stored to memory (variable) and written to whatever in sections, trying to read the entire registry into memory may or may not be possible, depending on machine configuration
    getsubkeys hkey, strkeypath, subkey
Next
End If
End Sub
 
' call like
Sub yy()
Const HKEY_CURRENT_USER As Long = &H80000001
strComputer = "."
Set oreg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
getsubkeys HKEY_CURRENT_USER, "", ""   ' get from root level
'or
getsubkeys HKEY_CURRENT_USER, "software\adobe", ""   ' starting at adobe 
Set oreg =  Nothing
End Sub

declare oreg as object in the general section

[Edgemeal]

How/Where is "arrsubkeys" supposed to be defined?

[westconn1]

has to be declared variant, i have edited the code to add the declaration

disclaimer here too, while this proceedure is pretty safe, anyone working with registry should take extra care, even to the extent of backing up the registry first

there is no way the the immediate window can contain all the subkeys from a hive, (works ok for a smaller tree), debug.print is for test purposes only

[Edgemeal]

Ok, but now I get error on line 11,

ByRef argument type mismatch

[westconn1]

i had not given a type to sk before, so it was a variant,
either change sk to variant or cstr(subkey)
i will modify the code to variant
arrsubkeys and subkey are afaik, required to be variant

[Edgemeal]

OK, changed to Variant, working now!

[westconn1]

updated to list all values as well as the keys

Sub getvals(hkey As Long, strpath As String, sk As Variant)
      Dim strkeypath As String, subkey As Variant, arrsubkeys As Variant, arrvalues As Variant
      Dim strvalue As Variant, arrvals As Variant, i As Integer, arrtypes As Variant, v As Integer
      DoEvents
      strkeypath = strpath
      If Not Len(sk) = 0 And Not Len(strpath) = 0 Then strkeypath = strpath & "\"
      strkeypath = strkeypath & sk
        oreg.enumvalues hkey, strkeypath, arrvalues, arrtypes
'        Debug.Print strkeypath & "\" & subkey
        If Not IsNull(arrvalues) Then
            ReDim Preserve regd(UBound(regd) + UBound(arrvalues) + 2)
            For i = 0 To UBound(arrvalues)
            strvalue = vbNullString
                Select Case arrtypes(i)
                    Case REG_SZ: oreg.getstringvalue hkey, strkeypath & "\" & subkey, arrvalues(i), strvalue
                    Case REG_DWORD: oreg.GetDWORDValue hkey, strkeypath & "\" & subkey, arrvalues(i), strvalue
                    Case REG_BINARY
                        oreg.getbinaryvalue hkey, strkeypath & "\" & subkey, arrvalues(i), strvalue
                        For v = 0 To UBound(strvalue)
                            strvalue(v) = Format(Hex(strvalue(v)), "00")
                        Next
                        strvalue = Join(strvalue, ",")
                    Case REG_EXPAND_SZ: oreg.GetExpandedStringValue hkey, strkeypath & "\" & subkey, arrvalues(i), strvalue
                    Case REG_MULTI_SZ
                        oreg.GetMultiStringValue hkey, strkeypath & "\" & subkey, arrvalues(i), arrvals
                        strvalue = Join(arrvals, vbNewLine & String(6, vbTab))
                End Select
                regd(j).strKeyName = strkeypath & "\" & subkey
                regd(j).strValueName = arrvalues(i)
                regd(j).strData = strvalue & ""
                j = j + 1
'                Debug.Print vbTab & vbTab & vbTab & arrvalues(i) & " = " & strvalue
                    ' or print to form or whatever
                ' for speed considerations should be stored to memory (variable) and written to whatever in sections, trying to read the entire registry into memory may or may not be possible, depending on machine configuration
            Next
        Else
                oreg.getstringvalue hkey, strkeypath & "\" & subkey, "", strvalue, arrtypes
                If j > UBound(regd) Then ReDim Preserve regd(j)
                regd(j).strKeyName = strkeypath & "\" & subkey
                regd(j).strValueName = "@"
                regd(j).strData = strvalue & ""
                j = j + 1
 
        End If
      oreg.EnumKey hkey, strkeypath, arrsubkeys
      If Not IsNull(arrsubkeys) Then
          For Each subkey In arrsubkeys
              getvals hkey, strkeypath, subkey
          Next
      End If
      End Sub

you need to put in the general section at the top

Dim oreg As Object
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const REG_SZ = 1
Private Const REG_EXPAND_SZ = 2
Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const REG_MULTI_SZ = 7
Private Type RegData
    strKeyName As String
    strValueName As String
    strData As String
End Type
      Dim regd() As RegData, j As Long

also need minor change to calling procedure

Sub yy()
      strComputer = "."
      ReDim regd(0)
      j = 0
      Set oreg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
'      getvals HKEY_CURRENT_USER, "", ""   ' get from root level
      'or
      getvals HKEY_CURRENT_USER, "software\foxit software", ""   ' starting at some key
      Set oreg = Nothing
      If UBound(regd) > j - 1 Then ReDim Preserve regd(j - 1)  ' remove any empty elements from end of array
      End Sub

edit: i have fixed the code now to save binary values as a Hex string, a bit similar to regedit
edit: i have modified the code to also return the default values, which are not returned by enumerating the values, if you don't want the empty ones added test for isnull(strvalue)
i have assumed that the default value is always of type REG_SZ, if anyone knows better please pm me

[skparkcn]

Dear westconn1

I am writing this reply on your comment on my question about registry manipulation. I copied your code to my excel file and compiled it, but met an error on line 8 in Sub getvals. Compliler says "arrtypes" was not defined. I also copied second code to general section (in the top of same module). Would you kindly explain why?

Thank you.

[westconn1]

Compliler says "arrtypes" was not defined.

you obviously have option explicit at the top of you module (as you should) , whereas i did not,
arrtypes should be declared a variant and v as integer, i have amended the posted code above

I also copied second code to general section (in the top of same module). Would you kindly explain why?

as this is a recursive procedure, so the same sub runs many times, called from within itself the type and variables declared at the top of the module are able to be accessed from any instance of the procedure, whereas the variable declared within the procedure may be different for each instance of the procedure

tested in excel 2000

[skparkcn]

Dear westconn1

I already solved my problem when I refer to your post above. I tried to post saying SOLVED but I just found it was not, right now.

Thank you for your comment.