Code Failing in Win7/Excel 2010, Works in XP/Excel 2007

[MartinS]

I have a block of code that opens and closes a registry key to find a piece of information that determines the user's location so that it can select the appropriate filepath when openeing a data file. It works fine in Windows XP with Office 2002 and 2007, but doesn't work in 32 or 64 bit versions of Windows 7 with Excel 2010.
Can anyone tell me what I need to change to get this working?

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

'\* Private API Function Declarations follow...
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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) 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

Thanks in advance
Martin

 

[MartinS]

I've updated the API calls to be 64-bit compatible:

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
        
Private Declare Function GetPrivateProfileSection Lib "kernel32" _
    Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, _
        ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
        
Declare PtrSafe Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" ( _
    ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, _
    ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

But still get the same results

 

[MartinS]

Can anyone help with this? It's becoming critical that I resolve this, as it could put a blocker on our new image rollout!
Can anyone at least point me in the direction of what the return codes mean?
Thanks
Martin