Excel VBA中RegOpenKeyExA函数模块与类调用返回值差异求助

我来帮你搞定这个在类模块里调用VBA注册表API返回错误5（拒绝访问）的问题！

你遇到的核心问题是类模块和标准模块对API函数的处理规则不一样，再加上原代码没考虑64位Office的兼容性：

• 类模块里的API声明必须明确标Private/Public，而且64位Office下必须加PtrSafe关键字，不然调用时参数传递会乱掉，最后就会弹出“拒绝访问”的错误（其实是调用失败的伪装提示）。
• 原代码用的是ANSI版的API（带A后缀），在类模块的字符串处理中容易出现内存对齐问题，直接导致注册表访问失败。

我们需要调整API声明适配类模块，同时优化注册表访问逻辑，具体如下：

1. 修正API声明（兼容32/64位Office） #

把类模块里的旧API声明全换掉，用下面这个兼容版本——重点是加PtrSafe，并且改用Unicode版的API（带W后缀），避免字符串编码坑：

2. 优化注册表访问逻辑 #

调整RegGetValue函数的参数处理，确保在类模块里字符串缓冲区能正常工作，不会出现内存溢出或参数错误。

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long
    Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExW" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As LongPtr) As Long
    Private Declare PtrSafe Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExW" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
    Private Const HKEY_CLASSES_ROOT As LongPtr = &H80000000
#Else
    Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
    Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExW" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
    Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExW" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
    Private Const HKEY_CLASSES_ROOT As Long = &H80000000
#End If

Private Const ERROR_SUCCESS As Long = 0&
Private Const REG_SZ As Long = 1&
Private Const REG_DWORD As Long = 4&
Private Const KEY_READ As Long = &H20019 ' 完整的注册表读取权限组合

Private Function RegGetValue(MainKey As Variant, SubKey As String, value As String) As String
    Dim sKeyType As Long
    Dim ret As Long
    Dim lpHKey As Variant
    Dim lpcbData As Long
    Dim ReturnedString As String
    Dim ReturnedLong As Long

    ' 初始化注册表句柄，适配32/64位
    #If VBA7 Then
        lpHKey = 0&
    #Else
        lpHKey = 0&
    #End If

    ' 尝试打开目标注册表项
    ret = RegOpenKeyEx(MainKey, SubKey, 0&, KEY_READ, lpHKey)
    If ret <> ERROR_SUCCESS Then
        RegGetValue = ""
        Exit Function
    End If

    ' 准备字符串缓冲区，大小设为255足够应对多数注册表项
    lpcbData = 255
    ReturnedString = Space$(lpcbData)
    
    ' 查询字符串类型的注册表值
    ret = RegQueryValueEx(lpHKey, value, ByVal 0&, sKeyType, ByVal ReturnedString, lpcbData)
    If ret = ERROR_SUCCESS Then
        If sKeyType = REG_SZ Then
            ' 截取有效字符串（去掉末尾的空字符）
            RegGetValue = Left$(ReturnedString, lpcbData - 1)
        ElseIf sKeyType = REG_DWORD Then
            ' 如果是DWORD类型，单独处理
            lpcbData = 4
            ret = RegQueryValueEx(lpHKey, value, ByVal 0&, sKeyType, ReturnedLong, lpcbData)
            If ret = ERROR_SUCCESS Then
                RegGetValue = CStr(ReturnedLong)
            End If
        End If
    Else
        RegGetValue = ""
    End If

    ' 必须关闭注册表句柄，避免资源泄漏
    Call RegCloseKey(lpHKey)
End Function

Public Function GetIcon(strExtension As String) As String
    Dim progID As String
    ' 先获取文件扩展名对应的ProgID
    progID = RegGetValue(HKEY_CLASSES_ROOT, strExtension, "")
    If progID <> "" Then
        ' 再通过ProgID查询默认图标路径
        GetIcon = RegGetValue(HKEY_CLASSES_ROOT, progID & "\DefaultIcon", "")
        ' 去掉图标路径后面的索引（比如",0"）
        If InStr(GetIcon, ",") > 0 Then
            GetIcon = Left(GetIcon, InStr(GetIcon, ",") - 1)
        End If
    End If
End Function

1. 兼容性适配：用#If VBA7 Then条件编译，同时支持32位和64位Office，PtrSafe关键字确保64位下函数调用的地址传递正确。
2. Unicode API：改用W后缀的Unicode版本API，避免ANSI字符串在类模块中出现编码转换错误，提升稳定性。
3. 权限优化：用完整的KEY_READ权限值&H20019，确保有足够的权限读取注册表项。
4. 逻辑容错：把GetIcon里的嵌套调用拆成两步，先获取ProgID再查图标，减少错误传递的概率。

把上面的代码放到你的类模块里（记得替换类名），然后在标准模块里测试：

Sub TestClassIcon()
    Dim iconHandler As New YourClassModuleName ' 换成你的类模块名称
    Dim pdfIconPath As String
    pdfIconPath = iconHandler.GetIcon(".pdf")
    Debug.Print pdfIconPath ' 现在应该能正常输出图标路径了！
End Sub

内容的提问来源于stack exchange，提问作者i_caster