John Clingeleffer
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\Te stLink"
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.
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\Te
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.
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_MA CHINE, pKey, 0&, KEY_QUERY_VALUE, hClassSubKey)
If l& <> ERROR_SUCCESS Then
MIEGetSetting = ""
Exit Function
End If
l& = RegQueryValueExNULL(hClass SubKey, pString, 0&, lType, 0&, cch)
sValue = String(cch + 1, Chr(0))
l& = RegQueryValueExString(hCla ssSubKey, pString, 0&, lType, sValue, cch)
' l& = RegQueryValueEx(hClassSubK ey, pString, 0&, lType, 0&, lBuffer)
' l& = RegQueryValueEx(hClassSubK ey, pString, 0&, lType, myKeyValue, ByVal lBuffer)
' l& = RegQueryValueEx(hClassSubK ey, 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\OD BC 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\Te stLink"
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
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_MA
If l& <> ERROR_SUCCESS Then
MIEGetSetting = ""
Exit Function
End If
l& = RegQueryValueExNULL(hClass
sValue = String(cch + 1, Chr(0))
l& = RegQueryValueExString(hCla
' l& = RegQueryValueEx(hClassSubK
' l& = RegQueryValueEx(hClassSubK
' l& = RegQueryValueEx(hClassSubK
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\OD
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\Te
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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.