Key/Value Lookup in Microsoft Access

When developing Access databases, one of the things I have noticed I have sometimes needed to do is to store information about the database itself in key/value. Some examples:
There are a lot of ways to store this information, e.g. in the Registry, in an .ini table. My preferred way of storing it would be a standard Access table, but they aren't really set up for storing data this manner. The way I worked around this is I created two routines - one to store key/value data in a predefined table, and one to read it back at out.

The subroutine StoreDBInfo takes two inputs - a key name and a value. It stores that information in tblDB_Info. The function GetDBInfo has a single input - the key name and it outputs the value for that specific key. If no value was stored, it raises an error.

For examples, the following code:

Public Sub Test() StoreDBInfo "User Name", "Matt Harris" MsgBox (GetDBInfo("User Name")) End Sub
creates a Key of "User Name" in tblDB_Info and stores the value of "Matt Harris" next to it. It then reads that Value stored with that Key and pops up a msgbox with that value:

      

In order to use these routines in Access:

  1. Create a new module in Access.
  2. Copy the "Key/Value Lookup code" below into that module.
  3. Run the routine CreateDBInfoTable once. It creates the table "tblDB_Info".
  4. Call StoreDBInfo with appropriate inputs when you wish to store data.
  5. Call GetDBInfo with the appropriate key to read the data back out.
'---------------Key/Value Lookup code---------------- ' 'The following code uses DAO, so make sure that under Tools | References 'you have "Microsoft DAO 3.6 Object Library" checked, or 'whatever is the appropriate version for your vesion of Access. ' 'If you have ADO also checked, make sure the DAO reference comes first Option Compare Database Option Explicit Private Const DB_Info_Table As String = "tblDB_Info" Public Sub StoreDBInfo(KeyID As String, KeyValue As Variant) On Error GoTo Error_Label Dim rst As Recordset Dim KeyType As Integer Set rst = CurrentDb.OpenRecordset(DB_Info_Table, dbOpenDynaset) rst.FindFirst "[KeyID]='" & KeyID & "'" If rst.NoMatch Then 'If Key is not found, add it rst.AddNew Else rst.Edit End If KeyType = VarType(KeyValue) rst.Fields!KeyID = KeyID rst.Fields!KeyValue = CStr(KeyValue) rst.Fields!KeyType = KeyType rst.Update Exit_Label: If Not IsEmpty(rst) Then rst.Close Exit Sub Error_Label: MsgBox (Err.Number & Err.Description) On Error GoTo 0 Resume Exit_Label End Sub Public Function GetDBInfo(KeyID As String) As Variant Dim rst As Recordset Dim KeyType As Integer Set rst = CurrentDb.OpenRecordset(DB_Info_Table, dbOpenDynaset) rst.FindFirst "[KeyID]='" & KeyID & "'" If rst.NoMatch Then rst.Close Set rst = Nothing Err.Raise vbObjectError + 1, , "No such Key ID." Else KeyType = rst.Fields!KeyType Select Case KeyType Case vbNull GetDBInfo = Null Case vbInteger GetDBInfo = CInt(rst.Fields!KeyValue) Case vbLong GetDBInfo = CLng(rst.Fields!KeyValue) Case vbSingle GetDBInfo = CSng(rst.Fields!KeyValue) Case vbDouble GetDBInfo = CDbl(rst.Fields!KeyValue) Case vbCurrency GetDBInfo = CCur(rst.Fields!KeyValue) Case vbDate GetDBInfo = CDate(rst.Fields!KeyValue) Case vbString GetDBInfo = rst.Fields!KeyValue Case vbError GetDBInfo = CVErr(rst.Fields!KeyValue) Case vbBoolean GetDBInfo = CBool(rst.Fields!KeyValue) Case vbDecimal GetDBInfo = CDec(rst.Fields!KeyValue) Case vbByte GetDBInfo = CByte(rst.Fields!KeyValue) Case Else rst.Close Set rst = Nothing Err.Raise vbObjectError + 2, , "Invalid data type in GetDBInfo." End Select End If If Not IsEmpty(rst) Then rst.Close End Function 'The following subroutine only needs to be run once 'It creates the table "tblDB_Info" which is used by the routines 'StoreDBInfo and GetDBInfo Public Sub CreateDBInfoTable() On Error GoTo Err_Label Dim SQL As String SQL = "CREATE TABLE tblDB_Info (KeyID TEXT (50) CONSTRAINT PrimaryKey PRIMARY KEY, " SQL = SQL & "KeyValue MEMO, KeyType INTEGER Not Null);" DoCmd.RunSQL SQL Exit_Label: Exit Sub Err_Label: If Err.Number <> 3010 Then MsgBox (Err.Number & " " & Err.Description) Resume Next Else '3010 means table already exists Resume Next End If End Sub


Created on ... March 21, 2004
Last Modified ... April 10, 2004