Reading from the registry

[Andy Johnston]

I am trying to determine the default entry for short date formats in the
Windows registry, i.e. dd/mm/yyyy for U.K., mm/dd/yyyy for U.S. etc. I am
doing this in MS Access using VBA's GetSetting function, the syntax of which
is

GetSetting (appname, section, key, [default])

My access database is called db2.mdb and is on the desktop. I have
therefore used the following line of code.

GetSetting("C:\Documents and Settings\BoxTop\Desktop\db2.mdb",
"HKEY_CURRENT_USER\Control Panel\International", "sShortDate")

This returns an empty string though even though there is an entry in the
registry. Can someone tell me what I'm doing wrong ?

[Steve Potts]

GetSetting and SaveSetting are internal to VBA and only read/write to a
specific registry area- that being:
HKEY_CURRENT_USER\Software\VB and VBA Program Settings\<dbName>

you can test by writing to the registry using SaveSetting("db2",
"MySection", "MyKeyName", "KeyValue")
and then open up the registry to see where it wrote it.

In Access97 you need to use API calls to get registry items outside this key
( Newer version may be simpler)

The following code comes from Ken Getz ( I think, I know it's not mine) and
it works great. At the bottom I show you how I've used it.

Option Compare Database
Option Explicit

' Declarations for Windows Registry procedures
Const regHKeyClassesRoot = &H80000000
Const regHKeyCurrentUser = &H80000001
Const regHKeyLocalMachine = &H80000002
Const regHKeyUsers = &H80000003

Const regErrorNone = 0
Const regErrorBadDB = 1
Const regErrorBadKey = 2
Const regErrorCantOpen = 3
Const regErrorCantRead = 4
Const regErrorCantWrite = 5
Const regErrorOutOfMemory = 6
Const regErrorInvalidParameter = 7
Const regErrorAccessDenied = 8
Const regErrorInvalidParameterS = 87
Const regErrorNoMoreItems = 259

Const regKeyAllAccess = &H3F
Const regKeyQueryValue = &H1

Const regOptionNonVolatile = 0
Const regSZ As Long = 1
Const regDWord As Long = 4

Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Declare Function TSB_API_RegCloseKey Lib "advapi32.dll" Alias "RegCloseKey"
_
(ByVal lngHKey As Long) _
As Long

Declare Function TSB_API_RegCreateKeyEx Lib "advapi32.dll" Alias
"RegCreateKeyExA" _
(ByVal lngHKey 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

Declare Function TSB_API_RegOpenKeyEx Lib "advapi32.dll" Alias
"RegOpenKeyExA" _
(ByVal lngHKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long,
ByVal samDesired As Long, _
phkResult As Long) _
As Long

Declare Function TSB_API_RegQueryValueExString Lib "advapi32.dll" Alias
"RegQueryValueExA" _
(ByVal lngHKey As Long, ByVal lpValueName As String, ByVal lpReserved As
Long, lpType As Long, _
ByVal lpData As String, lpcbData As Long) _
As Long

Declare Function TSB_API_RegQueryValueExLong Lib "advapi32.dll" Alias
"RegQueryValueExA" _
(ByVal lngHKey As Long, ByVal lpValueName As String, ByVal lpReserved As
Long, lpType As Long, _
lpData As Long, lpcbData As Long) _
As Long

Declare Function TSB_API_RegQueryValueExNULL Lib "advapi32.dll" Alias
"RegQueryValueExA" _
(ByVal lngHKey As Long, ByVal lpValueName As String, ByVal lpReserved As
Long, lpType As Long, _
ByVal lpData As Long, lpcbData As Long) _
As Long

Declare Function TSB_API_RegSetValueExString Lib "advapi32.dll" Alias
"RegSetValueExA" _
(ByVal lngHKey As Long, ByVal lpValueName As String, ByVal Reserved As
Long, ByVal dwType As Long, _
ByVal lpValue As String, ByVal cbData As Long) _
As Long

Declare Function TSB_API_RegSetValueExLong Lib "advapi32.dll" Alias
"RegSetValueExA" _
(ByVal lngHKey As Long, ByVal lpValueName As String, ByVal Reserved As
Long, ByVal dwType As Long, _
lpValue As Long, ByVal cbData As Long) _
As Long

Declare Function TSB_API_RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" _
(ByVal lngHKey As Long, ByVal dwIndex As Long, ByVal lpName As String,
cbName As Long) _
As Long

Declare Function TSB_API_RegQueryInfoKey Lib "advapi32.dll" Alias
"RegQueryInfoKeyA" _
(ByVal lngHKey As Long, ByVal lpClass As String, ByVal lpcbClass As Long,
ByVal lpReserved As Long, _
lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, ByVal lpcbMaxClassLen As
Long, lpcValues As Long, _
lpcbMaxValueNameLen As Long, ByVal lpcbMaxValueLen As Long, ByVal
lpcbSecurityDescriptor As Long, _
lpftLastWriteTime As FILETIME) _
As Long

Declare Function TSB_API_RegEnumValue Lib "advapi32.dll" Alias
"RegEnumValueA" _
(ByVal lngHKey As Long, ByVal dwIndex As Long, ByVal lpValueName As
String, lpcbValueName As Long, _
ByVal lpReserved As Long, ByVal lpType As Long, ByVal lpData As Byte,
ByVal lpcbData As Long) _
As Long

Declare Function TSB_API_RegDeleteKey Lib "advapi32.dll" Alias
"RegDeleteKeyA" _
(ByVal lngHKey As Long, ByVal lpSubKey As String) _
As Long

Declare Function TSB_API_RegDeleteValue Lib "advapi32.dll" Alias
"RegDeleteValueA" _
(ByVal lngHKey As Long, ByVal lpValueName As String) _
As Long

Function RegGetKeyValue(lngRootKey As Long, strKeyName As String,
strValueName As String) As Variant
' Comments : returns a registry value
' Parameters : lngRootKey - The root key value, must be one of the
following constants:
' regHKeyClassesRoot
' regHKeyCurrentUser
' regHKeyLocalMachine
' regHKeyUsers
' strkeyname - name of the key to open
' strValueName - value to open, vbNullString will open the
default value
' Returns : variant containing the value's data
'
Dim lngRetVal As Long
Dim lngHKey As Long
Dim varValue As Variant
Dim strValueData As String
Dim lngValueData As Long
Dim lngValueType As Long
Dim lngDataSize As Long

On Error GoTo PROC_ERR

varValue = Empty

lngRetVal = TSB_API_RegOpenKeyEx(lngRootKey, strKeyName, 0&,
regKeyAllAccess, lngHKey)

If regErrorNone = lngRetVal Then

lngRetVal = TSB_API_RegQueryValueExNULL(lngHKey, strValueName, 0&,
lngValueType, 0&, lngDataSize)

If regErrorNone = lngRetVal Then

Select Case lngValueType

' Strings type
Case regSZ:
strValueData = String(lngDataSize - 1, 0)
lngRetVal = TSB_API_RegQueryValueExString(lngHKey, strValueName,
0&, lngValueType, strValueData, lngDataSize)
If regErrorNone = lngRetVal Then
varValue = Left$(strValueData, lngDataSize)
Else
varValue = Empty
End If

' Long type
Case regDWord:
lngRetVal = TSB_API_RegQueryValueExLong(lngHKey, strValueName, 0&,
lngValueType, lngValueData, lngDataSize)
If regErrorNone = lngRetVal Then
varValue = lngValueData
End If

Case Else
'No other data types supported
lngRetVal = -1

End Select

End If

TSB_API_RegCloseKey (lngHKey)
End If

'Return varValue
RegGetKeyValue = varValue

PROC_EXIT:
Exit Function

PROC_ERR:
RegGetKeyValue = ""
Resume PROC_EXIT

End Function

Function GetTabWidth() As Long
GetTabWidth = RegGetKeyValue(regHKeyCurrentUser,
"Software\Microsoft\VBA\MSAccess", "TabWidth")
End Function

Function GetComputerName() As String
GetComputerName = RegGetKeyValue(regHKeyLocalMachine,
"SYSTEM\CurrentControlSet\Control\ComputerName\ActiveComputerName",
"ComputerName")
End Function

"Andy Johnston" <ajdata...@ukonline.co.uk> wrote in message
news:3d9c7ca2$0$11497$afc3...@news.ukonline.co.uk...