注册表存放着系统和应用程序的信息。一般情况下我们是不能去动的。如何利用VBA代码编辑注册表呢?包括增加、减少项及子项；增加、减少值；改写项、值等等。注册表操作,网上找了些,只有黄海的,但是运行时有问题,从VB中找了一个,在ACCESS中可以运行,现作为一个包提供给大家。

大家可以作成模块,用时方便。

文章作者： 想不通详细代码：

Option ExplicitOption Compare Text'---------------------------------------------------------------'- 注册表 API 声明…'---------------------------------------------------------------Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As LongPrivate 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, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As LongPrivate Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hkey As Long, ByVal lpSubKey As String) As LongPrivate Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hkey As Long, ByVal lpValueName As String) As LongPrivate Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As LongPrivate 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 LongPrivate Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As LongPrivate Declare Function RegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hkey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As LongPrivate Declare Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hkey As Long, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As LongPrivate Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As LongPrivate Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hkey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As LongPrivate 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, lpData As Byte, lpcbData As Long) As LongPrivate Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As LongPrivate 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 LongPrivate Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPriv As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long                'Used to adjust your program's security privileges, can't restore without it!Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As Any, ByVal lpName As String, lpLuid As LUID) As Long          'Returns a valid LUID which is important when making security changes in NT.Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As LongPrivate Declare Function GetCurrentProcess Lib "kernel32" () As Long'---------------------------------------------------------------'- 注册表 Api 常数…'---------------------------------------------------------------' 注册表创建类型值…Const REG_OPTION_NON_VOLATILE = 0        ' 当系统重新启动时，关键字被保留' 注册表关键字安全选项…Const READ_CONTROL = &H20000Const KEY_QUERY_VALUE = &H1Const KEY_SET_VALUE = &H2Const KEY_CREATE_SUB_KEY = &H4Const KEY_ENUMERATE_SUB_KEYS = &H8Const KEY_NOTIFY = &H10Const KEY_CREATE_LINK = &H20Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROLConst KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROLConst KEY_EXECUTE = KEY_READConst KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL                     ' 返回值…Const ERROR_NONE = 0Const ERROR_BADKEY = 2Const ERROR_ACCESS_DENIED = 8Const ERROR_SUCCESS = 0' 有关导入/导出的常量Const REG_FORCE_RESTORE As Long = 8&Const TOKEN_QUERY As Long = &H8&Const TOKEN_ADJUST_PRIVILEGES As Long = &H20&Const SE_PRIVILEGE_ENABLED As Long = &H2Const SE_RESTORE_NAME = "SeRestorePrivilege"Const SE_BACKUP_NAME = "SeBackupPrivilege"'---------------------------------------------------------------'- 注册表类型…'---------------------------------------------------------------Private Type SECURITY_ATTRIBUTES    nLength As Long    lpSecurityDescriptor As Long    bInheritHandle As BooleanEnd TypePrivate Type FILETIME    dwLowDateTime As Long    dwHighDateTime As LongEnd TypePrivate Type LUID    lowpart As Long    highpart As LongEnd TypePrivate Type LUID_AND_ATTRIBUTES    pLuid As LUID    Attributes As LongEnd TypePrivate Type TOKEN_PRIVILEGES    PrivilegeCount As Long    Privileges As LUID_AND_ATTRIBUTESEnd Type'---------------------------------------------------------------'- 自定义枚举类型…'---------------------------------------------------------------' 注册表数据类型…Public Enum EM_RegVarType    REG_NONE = 0                       ' No value type    REG_SZ = 1                         ' 字符串值    REG_EXPAND_SZ = 2                  ' 可扩充字符串值    REG_BINARY = 3                     ' 二进制值    REG_DWORD = 4                      ' DWORD值    REG_DWORD_BIG_ENDIAN = 5           ' 32-bit number    REG_LINK = 6                       ' Symbolic Link (unicode)    REG_MULTI_SZ = 7                   ' 多字符串值    REG_RESOURCE_LIST = 8              ' Resource list in the resource mapEnd Enum' 注册表关键字根类型…Public Enum EM_RegRootKey  HKEY_CLASSES_ROOT = &H80000000  HKEY_CURRENT_USER = &H80000001  HKEY_LOCAL_MACHINE = &H80000002  HKEY_USERS = &H80000003  HKEY_PERFORMANCE_DATA = &H80000004 '64系统位专用  HKEY_CURRENT_CONFIG = &H80000005  HKEY_DYN_DATA = &H80000006 '32位系统专用End EnumPrivate hkey As Long                   ' 注册表打开项的句柄Private I As Long, j As Long           ' 循环变量Private Success As Long                ' API函数的返回值, 判断函数调用是否成功'-------------------------------------------------------------------------------------------------------------'- 新建注册表关键字并设置注册表关键字的值…'- 如果 ValueName 和 Value 都缺省, 则只新建 KeyName 空项, 无子键…'- 如果只缺省 ValueName 则将设置指定 KeyName 的默认值'- 参数说明: KeyRoot--根类型, KeyName--子项名称, ValueName--值项名称, Value--值项数据, ValueType--值项类型'-------------------------------------------------------------------------------------------------------------Public Function SetKeyValue(KeyRoot As EM_RegRootKey, KeyName As String, Optional ValueName As String, Optional Value As Variant = "", Optional ValueType As EM_RegVarType = REG_SZ) As Boolean    Dim lpAttr As SECURITY_ATTRIBUTES                   ' 注册表安全类型    lpAttr.nLength = 50                                 ' 设置安全属性为缺省值…    lpAttr.lpSecurityDescriptor = 0                     ' …    lpAttr.bInheritHandle = True                        ' …        ' 新建注册表关键字…    Success = RegCreateKeyEx(KeyRoot, KeyName, 0, ValueType, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, hkey, 0)    If Success <> ERROR_SUCCESS Then SetKeyValue = False: RegCloseKey hkey: Exit Function        ' 设置注册表关键字的值…    If IsMissing(ValueName) = False Then        Select Case ValueType            Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ, REG_NONE                Success = RegSetValueEx(hkey, ValueName, 0, ValueType, ByVal CStr(Value), LenB(StrConv(Value, vbFromUnicode)) + 1)            Case REG_DWORD                If CDbl(Value) <= and="">= 0 Then                    Dim sValue As String                    sValue = DoubleToHex(Value)                    Dim dValue(3) As Byte                    dValue(0) = Format("&h" & Mid(sValue, 7, 2))                    dValue(1) = Format("&h" & Mid(sValue, 5, 2))                    dValue(2) = Format("&h" & Mid(sValue, 3, 2))                    dValue(3) = Format("&h" & Mid(sValue, 1, 2))                    Success = RegSetValueEx(hkey, ValueName, 0, ValueType, dValue(0), 4)                Else                    Success = ERROR_BADKEY                End If            Case REG_BINARY                On Error Resume Next                Success = 1                             ' 假设调用API不成功(成功返回0)                ReDim tmpValue(Ubound(Value)) As Byte                For I = 0 To Ubound(tmpValue)                    tmpValue(i) = Value(i)                Next I                Success = RegSetValueEx(hkey, ValueName, 0, ValueType, tmpValue(0), Ubound(Value) + 1)        End Select    End If    If Success <> ERROR_SUCCESS Then SetKeyValue = False: RegCloseKey hkey: Exit Function        ' 关闭注册表关键字…    RegCloseKey hkey    SetKeyValue = True                                       ' 返回函数值End Function'-------------------------------------------------------------------------------------------------------------'- 获得已存在的注册表关键字的值…'- 如果 ValueName="" 则返回 KeyName 项的默认值…'- 如果指定的注册表关键字不存在, 则返回空串…'- 参数说明: KeyRoot--根类型, KeyName--子项名称, ValueName--值项名称, ValueType--值项类型'-------------------------------------------------------------------------------------------------------------Public Function GetKeyValue(KeyRoot As EM_RegRootKey, KeyName As String, Optional ValueName As String = "", Optional ValueType As EM_RegVarType) As String    Dim TempValue As String                             ' 注册表关键字的临时值    Dim Value As String                                 ' 注册表关键字的值    Dim ValueSize As Long                               ' 注册表关键字的值的实际长度    TempValue = Space(1024)                             ' 存储注册表关键字的临时值的缓冲区    ValueSize = 1024                                    ' 设置注册表关键字的值的默认长度        ' 打开一个已存在的注册表关键字…    RegOpenKeyEx KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hkey        ' 获得已打开的注册表关键字的值…    RegQueryValueEx hkey, ValueName, 0, ValueType, ByVal TempValue, ValueSize        ' 返回注册表关键字的的值…    Select Case ValueType                                                        ' 通过判断关键字的类型, 进行处理        Case REG_SZ, REG_MULTI_SZ, REG_EXPAND_SZ, REG_NONE            TempValue = Left$(TempValue, ValueSize - 1)                          ' 去掉TempValue尾部空格            Value = TempValue        Case REG_DWORD            ReDim dValue(3) As Byte            RegQueryValueEx hkey, ValueName, 0, REG_DWORD, dValue(0), ValueSize            For I = 3 To 0 Step -1                Value = Value + String(2 - Len(Hex(dValue(i))), "0") + Hex(dValue(i))   ' 生成长度为8的十六进制字符串            Next I            If CDbl("&H" & Value) < 0 Then                                              ' 将十六进制的 Value 转换为十进制                Value = 2 ^ 32 + CDbl("&H" & Value)            Else                Value = CDbl("&H" & Value)            End If        Case REG_BINARY            If ValueSize > 0 Then                ReDim bValue(ValueSize - 1) As Byte                                     ' 存储 REG_BINARY 值的临时数组                RegQueryValueEx hkey, ValueName, 0, REG_BINARY, bValue(0), ValueSize                For I = 0 To ValueSize - 1                    Value = Value + String(2 - Len(Hex(bValue(i))), "0") + Hex(bValue(i)) + " "  ' 将数组转换成字符串                Next I            End If    End Select        ' 关闭注册表关键字…    RegCloseKey hkey    GetKeyValue = Trim(Value)                                                    ' 返回函数值End Function'-------------------------------------------------------------------------------------------------------------'- 删除已存在的注册表关键字的值…'- 如果指定的注册表关键字不存在, 则不做任何操作…'- 参数说明: KeyRoot--根类型, KeyName--子项名称, ValueName--值项名称'-------------------------------------------------------------------------------------------------------------Public Function DeleteKey(KeyRoot As EM_RegRootKey, KeyName As String, Optional ValueName As String) As Boolean    Dim tmpKeyName As String                            ' 注册表关键字的临时子项名称    Dim tmpValueName As String                          ' 注册表关键字的临时子键名称        ' 打开一个已存在的注册表关键字…    Success = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hkey)    If Success <> ERROR_SUCCESS Then DeleteKey = False: RegCloseKey hkey: Exit Function        ' 删除已打开的注册表关键字…    tmpKeyName = ""    tmpValueName = KeyName    If ValueName = "" Then                                              ' 判断ValueName是否缺省, 如缺省作相应处理        If InStrRev(KeyName, "\") > 1 Then            tmpValueName = Right(KeyName, InStrRev(KeyName, "\") + 1)            tmpKeyName = Left(KeyName, InStrRev(KeyName, "\") - 1)        End If        Success = RegOpenKeyEx(KeyRoot, tmpKeyName, 0, KEY_ALL_ACCESS, hkey)        Success = RegDeleteKey(hkey, tmpValueName)    Else        Success = RegDeleteValue(hkey, ValueName)    End If    If Success <> ERROR_SUCCESS Then DeleteKey = False: RegCloseKey hkey: Exit Function        ' 关闭注册表关键字…    RegCloseKey hkey    DeleteKey = True                                    ' 返回函数值End FunctionFunction DeleteSubkeyTree(ByVal hkey As Long, ByVal Subkey As String) As Boolean    Dim ret As Long, Index As Long, Name As String    Dim hSubkey As Long        ret = RegOpenKey(hkey, Subkey, hSubkey)    If ret <> 0 Then        DeleteSubkeyTree = False        Exit Function    End If    ret = RegDeleteKey(hSubkey, "")    If ret <> 0 Then        Name = String(256, Chr(0))        While RegEnumKey(hSubkey, 0, Name, Len(Name)) = 0 And _              DeleteSubkeyTree(hSubkey, Name)        Wend        ret = RegDeleteKey(hSubkey, "")    End If    DeleteSubkeyTree = (ret = 0)    RegCloseKey hSubkeyEnd Function'-------------------------------------------------------------------------------------------------------------'- 导出注册表关键字的值'- 参数说明: KeyRoot--根类型, KeyName--子项名称, FileName--导出的文件路径及文件名(原始数据库格式)'-------------------------------------------------------------------------------------------------------------Public Function SaveKey(KeyRoot As EM_RegRootKey, KeyName As String, FileName As String) As Boolean    On Error Resume Next        Dim lpAttr As SECURITY_ATTRIBUTES                   ' 注册表安全类型    lpAttr.nLength = 50                                 ' 设置安全属性为缺省值…    lpAttr.lpSecurityDescriptor = 0                     ' …    lpAttr.bInheritHandle = True                        ' …        If EnablePrivilege(SE_BACKUP_NAME) = False Then        SaveKey = False        Exit Function    End If        Success = RegOpenKeyEx(KeyRoot, KeyName, 0&, KEY_ALL_ACCESS, hkey)    If Success <> 0 Then        SaveKey = False        Success = RegCloseKey(hkey)        Exit Function    End If        Success = RegSaveKey(hkey, FileName, lpAttr)    If Success = 0 Then SaveKey = True Else SaveKey = False        Success = RegCloseKey(hkey)End Function'-------------------------------------------------------------------------------------------------------------'- 导入注册表关键字的值'- 参数说明: KeyRoot--根类型, KeyName--子项名称, FileName--导入的文件路径及文件名(原始数据库格式)'-------------------------------------------------------------------------------------------------------------Public Function RestoreKey(KeyRoot As EM_RegRootKey, KeyName As String, FileName As String) As Boolean    On Error Resume Next        If EnablePrivilege(SE_RESTORE_NAME) = False Then        RestoreKey = False        Exit Function    End If        Success = RegOpenKeyEx(KeyRoot, KeyName, 0&, KEY_ALL_ACCESS, hkey)    If Success <> 0 Then        RestoreKey = False        Success = RegCloseKey(hkey)        Exit Function    End If        Success = RegRestoreKey(hkey, FileName, REG_FORCE_RESTORE)    If Success = 0 Then RestoreKey = True Else RestoreKey = False        Success = RegCloseKey(hkey)End Function'-------------------------------------------------------------------------------------------------------------'- 使注册表允许导入/导出'-------------------------------------------------------------------------------------------------------------Private Function EnablePrivilege(seName As String) As Boolean    On Error Resume Next        Dim p_lngRtn As Long    Dim p_lngToken As Long    Dim p_lngBufferLen As Long    Dim p_typLUID As LUID    Dim p_typTokenPriv As TOKEN_PRIVILEGES    Dim p_typPrevTokenPriv As TOKEN_PRIVILEGES        p_lngRtn = OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, p_lngToken)    If p_lngRtn = 0 Then        EnablePrivilege = False        Exit Function    End If    If Err.LastDllError <> 0 Then        EnablePrivilege = False        Exit Function    End If        p_lngRtn = LookupPrivilegeValue(0&, seName, p_typLUID)    If p_lngRtn = 0 Then      EnablePrivilege = False      Exit Function    End If        p_typTokenPriv.PrivilegeCount = 1    p_typTokenPriv.Privileges.Attributes = SE_PRIVILEGE_ENABLED    p_typTokenPriv.Privileges.pLuid = p_typLUID        EnablePrivilege = (AdjustTokenPrivileges(p_lngToken, False, p_typTokenPriv, Len(p_typPrevTokenPriv), p_typPrevTokenPriv, p_lngBufferLen) <> 0)End Function'-------------------------------------------------------------------------------------------------------------'- 将 Double 型( 限制在 0--2^32-1 )的数字转换为十六进制并在前面补零'- 参数说明: Number--要转换的 Double 型数字'-------------------------------------------------------------------------------------------------------------Private Function DoubleToHex(ByVal Number As Double) As String    Dim strHex As String    strHex = Space(8)    For I = 1 To 8        Select Case Number - Int(Number / 16) * 16            Case 10                Mid(strHex, 9 - I, 1) = "A"            Case 11                Mid(strHex, 9 - I, 1) = "B"            Case 12                Mid(strHex, 9 - I, 1) = "C"            Case 13                Mid(strHex, 9 - I, 1) = "D"            Case 14                Mid(strHex, 9 - I, 1) = "E"            Case 15                Mid(strHex, 9 - I, 1) = "F"            Case Else                Mid(strHex, 9 - I, 1) = CStr(Number - Int(Number / 16) * 16)        End Select        Number = Int(Number / 16)    Next I    DoubleToHex = strHexEnd Function