- Download Steve McMahon's cRegistry class.
- Import it into your project a class module named "Registry".
- Replace all instances of
App.EXEName
withCurrentProject.Name
(The original was written for vb6. This will allow you to use it in vba.) - Add the following functions to the end of the class.
The functions findSectionKey
and getKeyValue
actually implement the class and are good examples of how to use it.
Public Function findSectionKey(sectToFind As String, Optional sectToLookIn As String = "") As String
'*****************************************************************************
' Christopher Kuhn 4-16-14
'
' Returns:
' Full section key as string
' ex: "software\wow6432Node\ODBC\ODBCINST.INI\Oracle in OraClient11g_home1"
' If a matching section key is not found, returns an empty string.
' Only returns first matching section key.
'
' Params:
' sectToFind - string representing the keynode you're searching for.
' ex: "ODBCINST.INI"
' sectToLookIn - String representing the keynode to start the search in.
' If omitted, use parent reg object's sectionKey value.
'*****************************************************************************
On Error GoTo ErrHandler:
Const PROC_NAME As String = "findSectionKey"
Dim sSect() As String ' string array of subnodes
Dim iSectCount As Long ' length of sSect array
Dim reg As Registry ' use a clone reg so we don't damage current object
' Test for optional sectToLookIn param
If sectToLookIn = "" Then
sectToLookIn = Me.sectionKey
End If
' create clone
Set reg = New Registry
With reg
.ClassKey = Me.ClassKey
.sectionKey = sectToLookIn
' create array of sections to search
.EnumerateSections sSect, iSectCount
' search each section in array
Dim i As Long
For i = 1 To iSectCount
'Debug.Print .sectionKey & "\" & sSect(i)
If findSectionKey = "" Then
If sSect(i) = sectToFind Then
' found node
findSectionKey = .sectionKey & "\" & sSect(i)
Exit For
Else
'search subnodes via recursion
findSectionKey = findSectionKey(sectToFind, .sectionKey & "\" & sSect(i))
End If
Else
Exit For
End If
Next i
End With
ExitFunction:
If Not (reg Is Nothing) Then
Set reg = Nothing
End If
Exit Function
ErrHandler:
'errBox CLASS_NAME, PROC_NAME
Resume ExitFunction
End Function
Public Function getKeyValue(valueKey As String, Optional sectToLookIn As String = "") As Variant
'*****************************************************************************
' Christopher Kuhn 4-16-14
'
' Returns:
' Value as variant
' If a matching value key is not found, returns an empty string.
' Only returns first matching value key.
'
' Params:
' valueKey - string representing the valueKey you're searching for.
' ex: "ORACLE_HOME"
' sectToLookIn - String representing the keynode to start the search in.
' If omitted, use parent reg object's sectionKey value.
' If parent reg does not have a sectionKey value, search everywhere.
'*****************************************************************************
On Error GoTo ErrHandler:
Const PROC_NAME As String = "findSectionKey"
Dim reg As Registry
Dim sKeys() As String
Dim iKeyCt As Long
Dim sSects() As String
Dim iSectCt As Long
Dim i As Long
Dim j As Long
' test for optional parameter
If sectToLookIn = "" And Me.sectionKey <> "" Then
sectToLookIn = Me.sectionKey
End If
' create reg clone so orginal is not damaged
Set reg = New Registry
With reg
.ClassKey = Me.ClassKey
If sectToLookIn <> "" Then
.sectionKey = sectToLookIn
End If
' for each value key in current section
.EnumerateValues sKeys, iKeyCt
For i = 1 To iKeyCt
If sKeys(i) = valueKey Then
' found key
.valueKey = sKeys(i)
getKeyValue = .value
Exit For
End If
Next i
' if key wasn't found, keep looking
If IsEmpty(getKeyValue) Then
' for each section key in current section
.EnumerateSections sSects, iSectCt
For j = 1 To iSectCt
If IsEmpty(getKeyValue) Then
' recursive call
If .sectionKey = "" Then
' no section specified
getKeyValue = getKeyValue(valueKey, sSects(j))
Else
' all other cases
getKeyValue = getKeyValue(valueKey, .sectionKey & "\" & sSects(j))
End If
Else
' found key already
Exit For
End If
Next j
End If
End With
ExitFunction:
If Not (reg Is Nothing) Then
Set reg = Nothing
End If
Exit Function
ErrHandler:
'errBox CLASS_NAME, PROC_NAME
Resume ExitFunction
End Function
Delete is called like this.
Public Sub Delete()
Dim reg As New Registry
With reg
.ClassKey = HKEY_CURRENT_USER
'delete registry Section key
.sectionKey = "Software\ODBC\odbc.ini\SomeDataSource"
If Exists Then
.DeleteKey
End If
End With
End Sub
*I would have posted my entire modification as is, but it exceeded the maximum number of characters allowed in an answer. Also, my extensions of Registry are not strictly necessary to delete a registry key. They might help you find instances of a specific key though.