Article ID: 149618
Article Last Modified on 6/29/2004
\\HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Jet\3.0\Engines
\\HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Jet\3.5\Engines\Jet 3.5
Option Explicit Private Const HKEY_LOCAL_MACHINE = &H80000002 Private Const REG_DWORD = 4& Private Const REG_OPTION_NON_VOLATILE = 0& Private Const KEY_ALL_ACCESS = &HF003F Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _ "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _ ByVal lpReserved As Long, lpType As Long, lpData As Any, _ lpcbData As Long) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" _ (ByVal hKey As Long) As Long 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 RegCreateKeyEx Lib "advapi32.dll" Alias _ "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _ ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions _ As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, _ phkResult As Long, lpdwDisposition As Long) As Long Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias _ "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _ ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _ ByVal cbData As Long) As Long Dim lpszKey As String Dim lpszSubKey As String Dim lpValueName As String Dim phkResult As Long Dim ReturnValue As Long Dim lresult As Long Dim lretval As Long Dim ptimeout As LongPlace the following code into the Form Load of the Form:
'Desired PageTimeout
ptimeout = 500 'This is .5 seconds
'Set up strings
lpszSubKey = "Software\Microsoft\Jet\3.0\Engines\Jet"
' for VB5 or VB6, lpszSubKey should equal:
' lpszSubKey = "Software\Microsoft\Jet\3.5\Engines\Jet 3.5"
lpszKey = HKEY_LOCAL_MACHINE
lpValueName = "PageTimeout"
'If the key exists open it or if not we will create it
lresult = RegCreateKeyEx(lpszKey, lpszSubKey, 0&, vbNullString, _
REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, phkResult, lretval)
'Search for lpValueName entry in lpszsubkey
lresult = RegQueryValueEx(phkResult, lpValueName, 0, REG_DWORD, _
lretval, 4)
'Check return value accordingly
Select Case lresult
Case 0
'Success
'Comment next line if you don't want to change the value if exists
lresult = RegSetValueEx(phkResult, lpValueName, 0, REG_DWORD, _
ptimeout, 4)
Case 2
'If entry doesn't exist create it and set it to ptimeout
lresult = RegSetValueEx(phkResult, lpValueName, 0, REG_DWORD, _
ptimeout, 4)
If lresult Then MsgBox "Could not set PageTimeout. Error:" & _
Str$(lresult)
Case Else
MsgBox "Unexpected Return Value:" & Str$(lresult)
End Select
'Close the updated key
lresult = RegCloseKey(phkResult)
Additional query words: kbVBp400 kbVBp500 kbVBp600 kbdse kbDSupport kbVBp kbDAO kbRegistry
Keywords: kbprb KB149618