Try this barrk. Cut and Paste into a module.
Wak!
I may be wrong, but I think you need to put an incrementation in your RegEnumKeyEx within your "Do Loop".
Code:
Option Explicit
'Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
'Private Const KEY_ENUMERATE_SUB_KEYS = &H8
' lng_Return = RegOpenKeyEx(HKEY_CURRENT_USER, "Software", 0, KEY_ENUMERATE_SUB_KEYS, lng_Handle)
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Const HKEY_CURRENT_USER = &H80000001
Sub Main()
'PURPOSE: Open the registry key.
Dim lng_Return As Long
Dim lng_Handle As Long ' handle
lng_Return = RegOpenKey(HKEY_CURRENT_USER, "Software", lng_Handle)
'PURPOSE: Make sure the key was opened successfully.
If lng_Return <> 0 Then
Debug.Print "Registry key could not be opened -- aborting."
End
End If
'PURPOSE: List through each possible subkey.
Dim f_LastWrite As FILETIME ' receives last-write-to time
Dim str_KeyName As String
Dim lng_KeyLength As Long
Dim str_Classname As String
Dim lng_ClassLength As Long
Dim int_X As Long
Do Until lng_Return <> 0
str_KeyName = Space(255)
lng_KeyLength = Len(str_KeyName)
str_Classname = Space(255)
lng_ClassLength = Len(str_Classname)
'PURPOSE: Get information about the next subkey
lng_Return = RegEnumKeyEx(lng_Handle, int_X, str_KeyName, lng_KeyLength, ByVal 0, str_Classname, lng_ClassLength, f_LastWrite)
If lng_Return = 0 Then ' only display info if another subkey was found
str_KeyName = Left(str_KeyName, lng_KeyLength) ' trim off the excess space
Debug.Print int_X & ". HKEY_CURRENT_USER\Software\"; str_KeyName
str_Classname = Left(str_Classname, lng_ClassLength)
Debug.Print "CLASS: "; str_Classname
Debug.Print ""
End If
int_X = int_X + 1
Loop
'PURPOSE: Close the registry key
Call RegCloseKey(lng_Handle)
End Sub
Have a good day! :)