bjames
asked on
Looping Registry Keys
I am trying to loop through a list of subkeys in the registry, but I am having no success. I am able to loop through string values using RegEnumValue, but RegEnumKeyEx is not working. Here is a copy of my code. What have I missed?
Thanks
Sub TestLoop()
'NOTE: sFullPath = "Software\MyCompany\Switch DB\Aliases "
mnlRetVal = RegOpenKeyEx(adhcnlhKey_LO CAL_MACHIN E, sFullPath, 0, KEY_READ, mnlhKey)
'mnlhKey does contain a value at this point
For nlKeyIndex = 0 To 10
Call RegEnumKeyEx(mnlhKey, nlKeyIndex, sKeyName, nlKeyLength, Null, Null, Null, mtoLastMod)
Debug.Print "sKeyName= " & Trim(sKeyName)
'sKeyName is always empty
Next nlKeyIndex
mnlRetVal = RegCloseKey(mnlhKey)
End Sub
Thanks
Sub TestLoop()
'NOTE: sFullPath = "Software\MyCompany\Switch
mnlRetVal = RegOpenKeyEx(adhcnlhKey_LO
'mnlhKey does contain a value at this point
For nlKeyIndex = 0 To 10
Call RegEnumKeyEx(mnlhKey, nlKeyIndex, sKeyName, nlKeyLength, Null, Null, Null, mtoLastMod)
Debug.Print "sKeyName= " & Trim(sKeyName)
'sKeyName is always empty
Next nlKeyIndex
mnlRetVal = RegCloseKey(mnlhKey)
End Sub
Try using vbNull instead of Null on the RegEnumKeyEx line
I actually think you'd want to use 0& rather than vbNull.
Call RegEnumKeyEx(mnlhKey, nlKeyIndex, sKeyName, nlKeyLength, 0&, 0&, 0&, mToLastMod)
Call RegEnumKeyEx(mnlhKey, nlKeyIndex, sKeyName, nlKeyLength, 0&, 0&, 0&, mToLastMod)
ASKER
Neither vbNull nor 0& made any difference. sKeyName is still an empty string.
It's not obvious what you've missed from what you've posted.
Here's your code altered slightly with the declarations included and additional error messaging features added. It works fine.
Option Compare Database
Option Explicit
Public Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const READ_CONTROL = &H20000
Public Const SYNCHRONIZE = &H100000
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const ERROR_NO_MORE_ITEMS = 259&
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public 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
Public Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageID As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Public Declare Function GetLastError Lib "kernel32" () As Long
Public 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
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Function getSystemError(dwMessageID As Long)
Dim myMessage As String
Dim myStrLen As Long
myMessage = Space(1024)
myStrLen = FormatMessage(FORMAT_MESSA GE_FROM_SY STEM, 0&, dwMessageID, 0&, myMessage, 1024, 0&)
If myStrLen <> 0 Then
myMessage = Left(myMessage, myStrLen)
Else
'Error in call to Format Message
myMessage = "Unable to determine error. FormatMessage is returning an error." & vbCrLf & vbCrLf & " " & getSystemError(GetLastErro r)
End If
getSystemError = myMessage
End Function
Sub TestLoop()
Dim sFullPath As String, mnlRetVal As Long, mnlhKey As Long
Dim nlKeyIndex As Long
Dim sKeyName As String
Dim nlKeyLength As Long
Dim mtoLastMod As FILETIME
sKeyName = Space(1024)
sFullPath = "Software\MyCompany\Switch DB\Aliases "
mnlRetVal = RegOpenKeyEx(HKEY_LOCAL_MA CHINE, sFullPath, 0, KEY_READ, mnlhKey)
If mnlRetVal <> 0 Then Err.Raise vbObjectError + 5000, "TestLoop", getSystemError(mnlRetVal)
Dim i As Integer
nlKeyIndex = 0
Do While True
i = 0
mnlRetVal = RegEnumKeyEx(mnlhKey, nlKeyIndex, sKeyName, 1024, 0&, 0&, 0&, mtoLastMod)
If mnlRetVal = ERROR_NO_MORE_ITEMS Then
Debug.Print "Done reading keys"
Exit Do
ElseIf mnlRetVal <> 0 Then
Err.Raise vbObjectError + 5001, "TestLoop", getSystemError(mnlRetVal)
Else
Debug.Print "sKeyName= " & Trim(sKeyName)
End If
nlKeyIndex = nlKeyIndex + 1
Loop
mnlRetVal = RegCloseKey(mnlhKey)
If mnlRetVal <> 0 Then Err.Raise vbObjectError + 5002, getSystemError(mnlRetVal)
End Sub
Here's your code altered slightly with the declarations included and additional error messaging features added. It works fine.
Option Compare Database
Option Explicit
Public Const FORMAT_MESSAGE_FROM_SYSTEM
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const READ_CONTROL = &H20000
Public Const SYNCHRONIZE = &H100000
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const ERROR_NO_MORE_ITEMS = 259&
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public 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
Public Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageID As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Public Declare Function GetLastError Lib "kernel32" () As Long
Public 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
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Function getSystemError(dwMessageID
Dim myMessage As String
Dim myStrLen As Long
myMessage = Space(1024)
myStrLen = FormatMessage(FORMAT_MESSA
If myStrLen <> 0 Then
myMessage = Left(myMessage, myStrLen)
Else
'Error in call to Format Message
myMessage = "Unable to determine error. FormatMessage is returning an error." & vbCrLf & vbCrLf & " " & getSystemError(GetLastErro
End If
getSystemError = myMessage
End Function
Sub TestLoop()
Dim sFullPath As String, mnlRetVal As Long, mnlhKey As Long
Dim nlKeyIndex As Long
Dim sKeyName As String
Dim nlKeyLength As Long
Dim mtoLastMod As FILETIME
sKeyName = Space(1024)
sFullPath = "Software\MyCompany\Switch
mnlRetVal = RegOpenKeyEx(HKEY_LOCAL_MA
If mnlRetVal <> 0 Then Err.Raise vbObjectError + 5000, "TestLoop", getSystemError(mnlRetVal)
Dim i As Integer
nlKeyIndex = 0
Do While True
i = 0
mnlRetVal = RegEnumKeyEx(mnlhKey, nlKeyIndex, sKeyName, 1024, 0&, 0&, 0&, mtoLastMod)
If mnlRetVal = ERROR_NO_MORE_ITEMS Then
Debug.Print "Done reading keys"
Exit Do
ElseIf mnlRetVal <> 0 Then
Err.Raise vbObjectError + 5001, "TestLoop", getSystemError(mnlRetVal)
Else
Debug.Print "sKeyName= " & Trim(sKeyName)
End If
nlKeyIndex = nlKeyIndex + 1
Loop
mnlRetVal = RegCloseKey(mnlhKey)
If mnlRetVal <> 0 Then Err.Raise vbObjectError + 5002, getSystemError(mnlRetVal)
End Sub
Sorry, I forgot to remove the reference to the "i" variable within TestLoop. I was originally using it for something, and forgot to take it out before I posted the code. It will work with it in there as it is (obviously it's not doing anything), but in case you were wondering I just forgot to take it out.
ASKER
I copied Clockwater's code and gave it a go. It ran without error and did give me my list of keys. I relooked at my code and tried to compare it with Clockwater's, but I still don't see where the difference is. No matter. Since Clockwatcher's code works and mine doesn't, I will use Clockwatcher's.
If Clockwatcher will lock the question I will accept the answer as 'Excellent'.
Thanks.
If Clockwatcher will lock the question I will accept the answer as 'Excellent'.
Thanks.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
This question was awarded, but never cleared due to the JSP-500 errors of that time. It was "stuck" against userID -1 versus the intended expert whom you awarded. This corrects the problem and the expert will now receive these points; points verified.
Please click on your Member Profile and select "View Question History" to navigate through any open or locked questions you may have to update and finalize them. If you are an EE Pro user, you can also choose Power Search to find all your open questions.
This is the Community Support link, if help is needed, along with the link to All Topics which reflects many TAs recently added.
https://www.experts-exchange.com/jsp/qList.jsp?ta=commspt
https://www.experts-exchange.com/jsp/zonesAll.jsp
Thank you,
Moondancer
Moderator @ Experts Exchange
Please click on your Member Profile and select "View Question History" to navigate through any open or locked questions you may have to update and finalize them. If you are an EE Pro user, you can also choose Power Search to find all your open questions.
This is the Community Support link, if help is needed, along with the link to All Topics which reflects many TAs recently added.
https://www.experts-exchange.com/jsp/qList.jsp?ta=commspt
https://www.experts-exchange.com/jsp/zonesAll.jsp
Thank you,
Moondancer
Moderator @ Experts Exchange