Link to home
Start Free TrialLog in
Avatar of John Clingeleffer
John ClingelefferFlag for Australia

asked on

Problem with Microsoft Access VBA

I am trying to have some Access VBA run on both 32 bit and 64 bit Microsoft Access. I followed the Microsoft instructions re PtrSafe and LongPtr.

The code follows:

Option Compare Database

Public Type SECURITY_ATTRIBUTES
        nLength As LongPtr
        lpSecurityDescriptor As LongPtr
        bInheritHandle As LongPtr
End Type

Public Declare PtrSafe Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal Reserved As LongPtr, ByVal lpClass As String, ByVal dwOptions As LongPtr, ByVal samDesired As LongPtr, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As LongPtr, lpdwDisposition As LongPtr) As LongPtr
Public Declare PtrSafe Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As LongPtr, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As LongPtr
Public Declare PtrSafe Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal lpReserved As LongPtr, lpType As LongPtr, lpData As String, lpcbData As LongPtr) As LongPtr
Public Const HKEY_LOCAL_MACHINE = &H80000002

Public Const REG_SZ = 1
Public Const REG_OPTION_NON_VOLATILE = 0
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const SYNCHRONIZE = &H100000
Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Public Const ERROR_SUCCESS = 0&

Public Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal ulOptions As LongPtr, ByVal samDesired As LongPtr, phkResult As LongPtr) As LongPtr
Public Declare PtrSafe Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As LongPtr) As LongPtr
Public Declare PtrSafe Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal Reserved As LongPtr, ByVal dwType As LongPtr, ByVal lpData As String, ByVal cbData As LongPtr) As LongPtr
Public Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As LongPtr) As LongPtr

'   Reference: MS Q145679
Declare PtrSafe Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal lpReserved As LongPtr, lpType As LongPtr, ByVal lpData As LongPtr, lpcbData As LongPtr) As LongPtr
Declare PtrSafe Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal lpReserved As LongPtr, lpType As LongPtr, ByVal lpData As String, lpcbData As LongPtr) As LongPtr
   

Public Function MIESaveSetting(ByVal pKey, ByVal pString As String, pValue As String)
    '   pKey "SOFTWARE\ODBC\ODBC.INI\TestLink"
    Dim l&, hKey&, ldisp&
    Dim sa As SECURITY_ATTRIBUTES

    sa.nLength = LenB(sa)
    l& = RegCreateKeyEx( _
        HKEY_LOCAL_MACHINE, _
        pKey, _
        0&, _
        vbNullString, _
        REG_OPTION_NON_VOLATILE, _
        KEY_ALL_ACCESS, _
        sa, _
     hKey, _
        ldisp)

    If l& = ERROR_SUCCESS Then
        l& = RegSetValueEx(hKey, pString, 0, REG_SZ, pValue, Len(pValue) + 1)
    End If

End Function

This code compiles and runs on 32bit Office with no problems but fails in 64 bit Office at the hKey variable with the error message "ByRef argument type mismatch".

Any ideas.
Avatar of Noah
Noah
Flag of Singapore image

Hi there! :)

Just to confirm before I start working on it... What is this Access VBA used for, any example files? It will be much faster if I have materials to reference the debugging and editing.
Avatar of John Clingeleffer

ASKER

Full function is to retrieve and set registry values. It works in conjunction with the main software package - Summit Event Manager - Pro.

Full code for the module follows:

Option Compare Database

Public Type SECURITY_ATTRIBUTES
        nLength As LongPtr
        lpSecurityDescriptor As LongPtr
        bInheritHandle As LongPtr
End Type

Public Declare PtrSafe Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal Reserved As LongPtr, ByVal lpClass As String, ByVal dwOptions As LongPtr, ByVal samDesired As LongPtr, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As LongPtr, lpdwDisposition As LongPtr) As LongPtr
Public Declare PtrSafe Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As LongPtr, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As LongPtr
Public Declare PtrSafe Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal lpReserved As LongPtr, lpType As LongPtr, lpData As String, lpcbData As LongPtr) As LongPtr
Public Const HKEY_LOCAL_MACHINE = &H80000002

Public Const REG_SZ = 1
Public Const REG_OPTION_NON_VOLATILE = 0
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const SYNCHRONIZE = &H100000
Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Public Const ERROR_SUCCESS = 0&

Public Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal ulOptions As LongPtr, ByVal samDesired As LongPtr, phkResult As LongPtr) As LongPtr
Public Declare PtrSafe Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As LongPtr) As LongPtr
Public Declare PtrSafe Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal Reserved As LongPtr, ByVal dwType As LongPtr, ByVal lpData As String, ByVal cbData As LongPtr) As LongPtr
Public Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As LongPtr) As LongPtr

'   Reference: MS Q145679
Declare PtrSafe Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal lpReserved As LongPtr, lpType As LongPtr, ByVal lpData As LongPtr, lpcbData As LongPtr) As LongPtr
Declare PtrSafe Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal lpReserved As LongPtr, lpType As LongPtr, ByVal lpData As String, lpcbData As LongPtr) As LongPtr
   


Public Function MIEGetSetting(ByVal pKey, ByVal pString) As String
    ' Dim myKeyValue As String * 2048
    Dim vValue As Variant, sValue As String
    Dim lType As LongPtr, cch As LongPtr
    Dim l As LongPtr, hKey As LongPtr, ldisp As LongPtr
    Dim sa As SECURITY_ATTRIBUTES
    lType = REG_SZ
    'Debug.Assert False
    ' l& = RegQueryValueEx(hKey, vbNullString,0&, lType, 0&, lBuffer)
    ' lBuffer = 256
    Dim hClassSubKey As LongPtr

    l& = RegOpenKeyEx(HKEY_LOCAL_MACHINE, pKey, 0&, KEY_QUERY_VALUE, hClassSubKey)
    If l& <> ERROR_SUCCESS Then
        MIEGetSetting = ""
        Exit Function
    End If

    l& = RegQueryValueExNULL(hClassSubKey, pString, 0&, lType, 0&, cch)
    sValue = String(cch + 1, Chr(0))
    l& = RegQueryValueExString(hClassSubKey, pString, 0&, lType, sValue, cch)

    ' l& = RegQueryValueEx(hClassSubKey, pString, 0&, lType, 0&, lBuffer)
    ' l& = RegQueryValueEx(hClassSubKey, pString, 0&, lType, myKeyValue, ByVal lBuffer)
    ' l& = RegQueryValueEx(hClassSubKey, pString, 0&, lType, 0&, lBuffer)

    If l& = ERROR_SUCCESS Then
        vValue = Left$(sValue, cch - 1)
    Else
        vValue = Empty
    End If
    MIEGetSetting = vValue

'    l& = RegCreateKeyEx( _
        HKEY_LOCAL_MACHINE, _
        "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources", _
        0&, _
        vbNullString, _
        REG_OPTION_NON_VOLATILE, _
        KEY_ALL_ACCESS, _
        sa, _
        hKey, _
        ldisp)
'    If l& = ERROR_SUCCESS Then
'        l& = RegSetValueEx(hKey, "TestLink", 0, REG_SZ, "SQL Server", 11)
'    End If

End Function    '   MIEGetSetting





Public Function MIESaveSetting(ByVal pKey, ByVal pString As String, pValue As String)
    '   pKey "SOFTWARE\ODBC\ODBC.INI\TestLink"
    Dim l&, hKey&, ldisp&
    Dim sa As SECURITY_ATTRIBUTES

    sa.nLength = LenB(sa)
    l& = RegCreateKeyEx( _
        HKEY_LOCAL_MACHINE, _
        pKey, _
        0&, _
        vbNullString, _
        REG_OPTION_NON_VOLATILE, _
        KEY_ALL_ACCESS, _
        sa, _
        hKey, _
        ldisp)

    If l& = ERROR_SUCCESS Then
        l& = RegSetValueEx(hKey, pString, 0, REG_SZ, pValue, Len(pValue) + 1)
    End If

End Function
Try hkey as LongLong
Dim hkey as LongLong

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Jim Dettman (EE MVE)
Jim Dettman (EE MVE)
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial