Hi Dom,
Create a table "tblAppConfig" with two textattributes "KeyName" and
"KeyValue" (My own version also has KeyType, for type conversion puposes).
Then put VBCode below in a module "modAppConfig" and use it like:
insert records in "tblAppConfig" like
KeyName KeyValue
"MyAppVersion" "1.14"
"MyAppName" "TheBestOnTheMarketApp"
call from debug window:
? "This is " & fnGetAppConfig("MyAppName") & " version " &
fnGetAppConfig("MyAppVersion")
That's it!
I also added a function to set a key/value pair in the table. You'll have to
test it further and add some errorhandling to it, because i extracted the
code from my own code and cutout everything not relevant to show here.
Note the function fnTransformSystemParam() called from fnGetAppConfig(). It
gives you the oppertunity to replace a parameter defined in the app with a
runtime value. For example:
You have subfolders in your applicationpath where you keep MSWord documents
or maybe JPG pictures. You could then create a key/value pair
"MyPicturePath"="%FRONTENDPATH%\Pictures\". If you call
fnGetAppConfig("MyPicturePath") it will return the full path to your picture
folder.
In my own version i also have a param for the backendpath, but that needs a
littlebit more coding. You can make your whole app configurable through this
functions.
The function fnStringTrans() is there in case you use MSAccess97 (In later
versions you have function replace().).
Good luck!
Sid.
----------------------------------------------------------------------------
-------------
Public Function fnGetAppConfig(strKeyName As String, Optional
strDefaultValue As String) As String
Dim dbs As Database, rst As Recordset
Dim strSQL As String
fnGetAppConfig= ""
Set dbs = CurrentDb
strSQL = "SELECT * FROM tblAppConfig WHERE KeyName=" & "'" & strKeyName
& "'"
Set rst = dbs.OpenRecordset(strSQL)
If Not rst.EOF() Then
fnGetAppConfig= rst!KeyValue
If Len(GetAppConfig)=0 And Not IsMissing(strDefaultValue) Then
fnGetAppConfig= strDefaultValue & ""
fnSetAppConfig strKey , strDefaultValue & ""
Else
fnGetAppConfig= fnTransformSystemParams(UCase(fnGetAppConfig))
End If
End If
rst.Close
Set rst = Nothing
Set dbs = Nothing
End Function
Function fnTransformSystemParams(strKeyValue As String) As String
fnTransformSystemParams= strKeyValue
fnTransformSystemParams= fnStringTrans(TransformSystemParams,
"%FRONTENDPATH%", UCase(GetDBPath()), False)
fnTransformSystemParams= fnStringTrans(TransformSystemParams,
"%MSACCESSPATH%", UCase(SysCmd(acSysCmdAccessDir)), False)
fnTransformSystemParams= fnStringTrans(TransformSystemParams,
"%WORKGROUPPATH%", UCase(SysCmd(acSysCmdGetWorkgroupFile)), False)
End Function
Public Function fnSetAppConfig(strKeyName As String, strKeyValue As String)
As Boolean
Dim dbs As Database, rst As Recordset
Dim strSQL As String
fnSetAppConfig= False
If strKeyName<>"" Then
Set dbs = CurrentDb
strSQL = "SELECT * FROM tblAppConfig WHERE [KeyName]='" & strKeyName &
"'"
Set rst = dbs.OpenRecordset(strSQL)
If Not rst.EOF Then
rst.MoveFirst
rst.Edit
rst!KeyValue= strKeyValue
Else
rst.AddNew
rst!KeyName= strKeyName
rst!KeyValue= strKeyValue
End If
rst.update
rst.Close
Set rst = Nothing
Set dbs = Nothing
fnSetAppConfig= True
End If
End Function
Function fnStringTrans(strString As String, strSearch As String, strReplace
As String, Optional blnExact As Boolean) As String
Dim intCurPos As Integer
If IsMissing(blnExact) Then
blnExact = True
End If
intCurPos = InStr(1, strString, strSearch, IIf(blnExact, 0, 1))
While intCurPos > 0
strString = Left(strString, intCurPos - 1) + strReplace +
Mid(strString, intCurPos + Len(strSearch))
intCurPos = InStr(intCurPos + Len(strReplace), strString, strSearch,
IIf(blnExact, 0, 1))
Wend
fnStringTrans = strString
End Function
