У меня есть блок кода, который открывает и закрывает раздел реестра, чтобы найти часть информации, которая определяет местоположение пользователя, чтобы он мог выбрать подходящий путь к файлу при открытии файла данных. Он отлично работает в Windows XP с Office 2002 и 2007, но не работает в 32- или 64-разрядных версиях Windows 7 с Excel 2010.
Может кто-нибудь сказать мне, что мне нужно изменить, чтобы это работало?
'\* 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, соответственно, являются тем, что бросает меня.
Заранее спасибо
Martin