Question

我有一段代码，用于打开和关闭注册表项，以查找确定用户位置的信息，以便在打开数据文件时选择适当的文件路径。它在带有Office 2002和2007的Windows XP中工作正常，但在带有Excel 2010的32位或64位版本的Windows 7中不起作用。
任何人都可以告诉我我需要改变什么才能使这个工作？

'\* Module Level Constant Declarations follow...
Private Const cvarRegistrySize = 1
Private Const cvarHkeyLocalMachine = &H80000002
Private Const cvarKeyQueryValue = &H2

'\* Private API Function Declarations follow...
Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal ulOptions As Long, _
    ByVal samDesired As Long, phkResult As LongPtr) As Long
Declare PtrSafe Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal lpReserved As LongPtr, _
lpType As Long, lpData As Any, lpcbData As Long) As Long               
Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long

'\* Dimension variables at module level...
Private strSearchKey    As String
Private strRegion       As String
Private intCharLen      As Integer
Private intSubChar      As Integer
Private lngRegKey       As Long
Private lngSizeVar      As Long
Private lngReturnCode   As Long
'****************************************************************************
'* Function to extract the current region from the registry                 *
'****************************************************************************
Function GETREGION() As String
'\* registry key for user's location...
strSearchKey = "SOFTWARE\CompanyName\LogonProcess"
'\* open registry key...
lngReturnCode = RegOpenKeyEx(cvarHkeyLocalMachine, strSearchKey, 0, cvarKeyQueryValue, lngRegKey) 'returns 2
'\* return value from specified key...
strSearchKey = "CurrentLocation"
'\* return section of string from specified key...
strRegion = String(20, 32)
'\* returns the length of the string...
lngSizeVar = Len(strRegion) - 1
'\* query the registry key...
lngReturnCode = RegQueryValueEx(lngRegKey, strSearchKey, 0, cvarRegistrySize, ByVal strRegion, lngSizeVar) 'returns 6
'\* close the registry key...
    Call RegCloseKey(lngRegKey)
'\* select the location from the string...
lngReturnCode = GETSTR(GETREGION, strRegion, 1, vbNullChar)
'\* return result to function as uppercase...
    GETREGION = StrConv(GETREGION, vbUpperCase)
End Function

'****************************************************************************
'* Function to extract a section from a string from a given start position  *
'* up to a specified character.                                             *
'****************************************************************************
Function GETSTR(strX As String, strY As String, intStartPos As Integer, intSearchChar As String) As Integer
'\* initialisation of variables follows...
GETSTR = intStartPos
strX = ""
intCharLen = Len(strY)
intSubChar = intStartPos
'\* if comparison character at start position then leave function with empty extracted string...                                                      *
    If Mid(strY, intStartPos, 1) = intSearchChar Then Exit Function
'\* begin loop...
        Do
'\* create integer value based on character positions...
            strX = strX + Mid(strY, intSubChar, 1)
'\* increment counter...
                intSubChar = intSubChar + 1
'\* if counter exceeds string length, exit loop...
                    If intSubChar > intCharLen Then Exit Do
'\* define loop conditions...
        Loop Until Mid(strY, intSubChar, 1) = intSearchChar
'\* return character position to function...
GETSTR = intSubChar
End Function

我解决这个问题变得越来越重要，因为它可能会阻止我们新桌面映像的推出，因为此代码用于Excel加载项的一部分，该加载项部署到所有计算机和被大量员工使用。
RegOpenKeyEx和RegQueryValueEx分别为2和6的返回码是扔我的提前谢谢你马丁

Answer 1

错误代码表示

（0x000002）系统找不到指定的文件（0x000006）句柄无效

您通过cvarKeyQueryValue = &H2作为samDesired权限请求KEY_SET_VALUE (0x0002) - 在Windows 7上没有提升，此写入请求将被拒绝。

尝试使用KEY_READ (0x20019)打开密钥，因为您只需要读取值。

Win7 / Excel 2010中的VBA代码失败，适用于XP / Excel 2007

1 个答案: