Option Explicit
' Registry value type definitions
Private Const REG_NONE As Long = 0
Private Const REG_SZ As Long = 1
Private Const REG_EXPAND_SZ As Long = 2
Private Const REG_BINARY As Long = 3
Private Const REG_DWORD As Long = 4
Private Const REG_LINK As Long = 6
Private Const REG_MULTI_SZ As Long = 7
Private Const REG_RESOURCE_LIST As Long = 8
Public Const REG_OPTION_NON_VOLATILE = 0
Private Const KEY_ALL_ACCESS As Long = &H3F
' Registry section definitions
Public Const HKEY_CURRENT_USER As Long = &H80000001
Private Const c_strKey_8a As String = _
"Software\Microsoft\Office\8.0\Excel\Options\"
Private Const c_strKey_8b As String = _
"Software\Microsoft\Office\8.0\Excel\Add-in Manager\"
Private Const c_strKey_9a As String = _
"Software\Microsoft\Office\9.0\Excel\Options\"
Private Const c_strKey_9b As String = _
"Software\Microsoft\Office\9.0\Excel\Add-in Manager\"
Private Const c_strKey_10a As String = _
"Software\Microsoft\Office\10.0\Excel\Options\"
Private Const c_strKey_10b As String = _
"Software\Microsoft\Office\10.0\Excel\Add-in Manager\"
Private Const c_strKey_11a As String = _
"Software\Microsoft\Office\11.0\Excel\Options\"
Private Const c_strKey_11b As String = _
"Software\Microsoft\Office\11.0\Excel\Add-in Manager\"
' Registry API functions
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _
"RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal _
Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal _
samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, _
lpdwDisposition As Long) As Long
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 Declare Function RegSetValueExString Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal _
Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData _
As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal _
Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As _
Long) As Long
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 RegEnumValue Lib "advapi32.dll" Alias _
"RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName _
As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, _
ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias _
"RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
' Delete all registry keys that contain the named add-in
Public Function GetAllValues(strAddInName As String) As Single
Dim varTemp As Variant
Dim strKey As String
Dim strValue As String
Dim strValueData As String
Dim strSection As String
Dim strDelVal As String
Dim i As Long
Dim j As Long
Dim sngErrorCode As Single
On Error GoTo ErrHandler
For i = 1 To 8
Select Case i
Case Is = 1: strSection = c_strKey_8a
Case Is = 2: strSection = c_strKey_8b
Case Is = 3: strSection = c_strKey_9a
Case Is = 4: strSection = c_strKey_9b
Case Is = 5: strSection = c_strKey_10a
Case Is = 6: strSection = c_strKey_10b
Case Is = 7: strSection = c_strKey_11a
Case Is = 8: strSection = c_strKey_11b
End Select
j = 0
sngErrorCode = 10 ' Search through specified registry key
'Searches through the add-in key and locates the Map add-in if it _
exists, the value is then deleted
Do While Not (strValue = "Not Found")
varTemp = ReadRegistryGetAll(HKEY_CURRENT_USER, strSection, j)
j = j + 1
sngErrorCode = 20 ' Find which values are strings
If varTemp(0) = REG_SZ Then
strValue = varTemp(1)
strValueData = varTemp(2)
sngErrorCode = 30 ' Check if add-in is in the specified
Strings
If (InStr(strValue, strAddInName) > 0) Or _
(InStr(strValueData, strAddInName) > 0) Then
strDelVal = DeleteValue(HKEY_CURRENT_USER, strSection, _
strValue)
End If
End If
sngErrorCode = 40 ' Check if loop needs to be ended
If varTemp(0) = 0 Then Exit Do
Loop
Next i
sngErrorCode = 0
GetAllValues = sngErrorCode
Exit Function
ErrHandler:
GetAllValues = sngErrorCode
End Function
' Retrieves all the values from anywhere in the Registry under a given _
subkey, currently only returns string and double word values
Public Function ReadRegistryGetAll(ByVal lngGroup As Long, ByVal strSection _
As String, lngIndex As Long) As Variant
Dim lngResult As Long
Dim lngKeyValue As Long
Dim lngDataTypeValue As Long
Dim lngValueLength As Long
Dim lngValueNameLength As Long
Dim strValueName As String
Dim strValue As String
Dim dblTemp As Double
On Error Resume Next
lngResult = RegOpenKey(lngGroup, strSection, lngKeyValue)
strValue = Space$(2048)
strValueName = Space$(2048)
lngValueLength = Len(strValue)
lngValueNameLength = Len(strValueName)
lngResult = RegEnumValue(lngKeyValue, lngIndex, strValueName, _
lngValueNameLength, 0&, lngDataTypeValue, strValue, lngValueLength)
If (lngResult = 0) And (Err.Number = 0) Then
If lngDataTypeValue = REG_DWORD Then
dblTemp = Asc(Mid$(strValue, 1, 1)) + &H100& * Asc(Mid$(strValue, _
2, 1)) + &H10000 * Asc(Mid$(strValue, 3, 1)) + &H1000000 * _
CDbl(Asc(Mid$(strValue, 4, 1)))
strValue = Format$(dblTemp, "000")
End If
strValue = Left$(strValue, lngValueLength - 1)
strValueName = Left$(strValueName, lngValueNameLength)
Else
strValue = "Not Found"
End If
lngResult = RegCloseKey(lngKeyValue)
ReadRegistryGetAll = Array(lngDataTypeValue, strValueName, strValue)
End Function
' Deletes a specified key (and all its subkeys and values if on Win95) from _
the registry
Public Function DeleteValue(ByVal lngGroup As Long, ByVal strSection As _
String, ByVal strKey As String) As String
Dim lngResult As Long
Dim lngKeyValue As Long
On Error Resume Next
lngResult = RegOpenKey(lngGroup, strSection, lngKeyValue)
lngResult = RegDeleteValue(lngKeyValue, strKey)
lngResult = RegCloseKey(lngKeyValue)
End Function
' Set the data field of a value
Public Function SetKeyValue(lngPredefinedKey As Long, strKeyName As String, _
strValueName As String, varValueSetting As Variant, lngValueType As Long)
Dim lngRetVal As Long ' result of the SetValueEx function
Dim hKey As Long ' handle of open key
'open the specified key
lngRetVal = RegCreateKeyEx(lngPredefinedKey, strKeyName, 0&, _
vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hKey, lngRetVal)
lngRetVal = SetValueEx(hKey, strValueName, lngValueType, varValueSetting)
Call RegCloseKey(hKey)
End Function
' Set the data field of a value
Public Function SetValueEx(ByVal hKey As Long, strValueName As String, _
lngType As Long, varValue As Variant) As Long
Dim lngValue As Long
Dim strValue As String
Select Case lngType
Case REG_SZ
strValue = varValue
SetValueEx = RegSetValueExString(hKey, strValueName, 0&, _
lngType, strValue, Len(strValue))
Case REG_DWORD
lngValue = varValue
SetValueEx = RegSetValueExLong(hKey, strValueName, 0&, lngType, _
lngValue, 4)
End Select
End Function
Display More