- 下载Steve McMahon's cRegistry
class。
- 将一个名为“Registry”的类模块导入到您的项目中。
- 将
App.EXEName 的所有实例替换为CurrentProject.Name
（原文是为 vb6 编写的。这将允许您在
vba.)
- 将以下函数添加到类的末尾。
findSectionKey 和 getKeyValue 函数实际上实现了这个类，并且是如何使用它的好例子。
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
删除是这样调用的。
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
*我会按原样发布我的整个修改，但它超过了答案中允许的最大字符数。此外，我的注册表扩展并不是删除注册表项所必需的。不过，它们可能会帮助您找到特定键的实例。