[AccessD] Using Lateral Thinking To solve problems - This time it is DB Properties

Using Lateral Thinking To solve problems - This time it is DB Properties

As you know, I try to solve problems by thinking Laterally (Outside the box)

Recently I tried to solve the problem of storing various language
translations within the TAG property of the Form.  

This worked just fine and give instant ability to swap languages in seconds.
I had also posted code to permanent store this by manipulating the form in
hidden design mode.

This posting is about storing data in the DB user defined properties.
Regretfully there are limits to how much info you can store before Access
goes all wobbly, coughs and posts a message to you (in my case, it gave up
after 222 User Defined Properties storing 7,962 characters).  

Anyway I am going to post the code because there may be Listers who would
like to store other stuff in these user defined properties, such as licence
details, expiry details, how many users logged on, how much xyz. Tracking,
recording etc.  Just change the code as required.

Max

Option Compare Database
Option Explicit
Public Function pfMaxGetLanguageCaptionsAvailable()
  Const conPipe As String = "|"
  Const conSeparator As String = ">|<"
  Dim rst As DAO.Recordset, sql As String, strLanguages As String
  Dim strEnglish As String, strChineseComplex As String, strChineseSimple As
String
  Dim strSpanish As String, strFrench As String
  Dim str As String
  
  sql = "Select * from [tblLanguage-Controls] ORDER BY
fldLanguageForm,fldLanguageControl"
  Set rst = CurrentDb.OpenRecordset(sql)
  If Not rst.EOF Then
    rst.MoveFirst
    Do While Not rst.EOF
      str = "English" & conPipe & rst!fldLanguageForm & conPipe &
rst!fldLanguageControl
      Call sMaxDBCreateLanguageProperties(str, dbText,
Nz(rst!fldlanguageEnglish, " "))
      
       str = "ChineseComplex" & conPipe & rst!fldLanguageForm & conPipe &
rst!fldLanguageControl
      Call sMaxDBCreateLanguageProperties(str, dbText,
Nz(rst!fldLanguageChineseComplex, " "))
      
      str = "ChineseSimple" & conPipe & rst!fldLanguageForm & conPipe &
rst!fldLanguageControl
      Call sMaxDBCreateLanguageProperties(str, dbText,
Nz(rst!fldLanguageChineseSimple, " "))
      
      str = "Spanish" & conPipe & rst!fldLanguageForm & conPipe &
rst!fldLanguageControl
      Call sMaxDBCreateLanguageProperties(str, dbText,
Nz(rst!fldLanguageSpanish, " "))
      
      str = "French" & conPipe & rst!fldLanguageForm & conPipe &
rst!fldLanguageControl
      Call sMaxDBCreateLanguageProperties(str, dbText,
Nz(rst!fldLanguageFrench, " "))
     
      rst.MoveNext
    Loop
  End If
End Function

Private Sub sMaxDBCreateLanguageProperties(strPrpName As String, varPrpType
As Variant, varPrpValue As Variant)
  On Error GoTo errhandler
   Dim prpLanguage As Property
   Static lngCt As Long
   Static lngSize As Long
   lngCt = lngCt + 1
   lngSize = lngSize + Len(strPrpName)
   Debug.Print lngCt, lngSize, strPrpName, varPrpValue
  CurrentDb.Properties.Delete strPrpName
   Set prpLanguage = CurrentDb.CreateProperty()
   prpLanguage.Name = strPrpName: prpLanguage.Type = varPrpType:
prpLanguage.Value = varPrpValue
   CurrentDb.Properties.Append prpLanguage
   
exithere:
   Exit Sub
errhandler:
   Select Case Err.Number
   Case 3265, 3367 ' property doesnt exits or doesnt exits
   Resume Next
   Case Else
    MsgBox "Error in sMaxCreateLanguageProperty(): " & Err.Number & vbCrLf &
Err.Description
  End Select
  Resume exithere
End Sub

Private Sub sMaxDBEnumerateDatabaseProperties()
  ' if You needs to see the properties
  Dim prp As Property
  On Error Resume Next
  For Each prp In CurrentDb.Properties
    Debug.Print prp.Name, prp.Value
  Next prp
End Sub

Private Sub sMaxDeleteDatabaseProperties()
  Dim strPrpName As String
  Dim prp As Property
  On Error Resume Next
  For Each prp In CurrentDb.Properties
    strPrpName = prp.Name
    If Left(strPrpName, 7) = "English" Or Left(strPrpName, 6) = "French" Or
Left(strPrpName, 14) = "ChineseComplex" Or Left(strPrpName, 13) =
"ChineseSimple" Or Left(strPrpName, 7) = "Spanish" Then
      CurrentDb.Properties.Delete strPrpName
      Debug.Print strPrpName
    End If
  Next prp

End Sub