Login or Sign Up to become a member!
LessThanDot Sit Logo

LessThanDot

Community Wiki

Less Than Dot is a community of passionate IT professionals and enthusiasts dedicated to sharing technical knowledge, experience, and assistance. Inside you will find reference materials, interesting technical discussions, and expert tips and commentary. Once you register for an account you will have immediate access to the forums and all past articles and commentaries.

LTD Social Sitings

Lessthandot twitter Lessthandot Linkedin Lessthandot friendfeed Lessthandot facebook Lessthandot rss

Note: Watch for social icons on posts by your favorite authors to follow their postings on these and other social sites.

Navigation

Google Ads

Custom Database Properties Creation and Use

From Wiki

Jump to: navigation, search

Contents [Hide]

How to Create and Use Custom DAO Database Properties

Custom Database Properties can be very useful. They "Persist", which means they remain when the database has been closed and opened again. They are like Global Variables that never go away until you delete them. They are handy for keeping your Version or Copyright data among other uses. You may also want to to use them to conceal some sensitive data from the user.

Perhaps more importantly, if you want to use code to set some startup properties, you have to create specific Custom Database Properties. For example to hide the Database Window, disable Access Special Keys, Allow Built-In Toolbars, set the Application Title, Application Icon, or set the Startup Form you have to create a Custom Database Property.

The Custom Database Properties we are using are DAO Workspaces Properties. That is why we use Set db = DBEngine(0)(0). The (0)(0) represents Workspaces(0).Databases(0).

There are three properties you must set when you create a Custom DAO Workspaces Property. They are Name, Type, and Value. The Type will be Boolean for some startup properties, for others it will be String. For our purposes we will be using the String Type.

The following Functions allow you to create, read, set, and delete Custom Database Properties.

Sample Custom Database Functions


Create a Custom Database Property


To Create a Custom Database Property we must first define the Property's Name, Type, and Value using the CreateProperty Method. Then we use the Append Method to add it to the DAO Workspaces Collection.

textLine number Off | Hide | Select all
  1. '---------------------------------------------------------------------------------------
  2. ' Procedure : CreateDBStrProp
  3. ' Purpose   : Create a Custom Database Property of dbText (string) type
  4. ' Arguments : strPropName As String-the Property Name
  5. '           : strPropValue As String-the Property Value
  6. '---------------------------------------------------------------------------------------
  7.  
  8. Function CreateDBStrProp(strPropName As String, strPropValue As String) As Boolean
  9. On Error GoTo Err_CreateDBStrProp
  10.  
  11.     Dim db As DAO.Database
  12.     Dim prp As Property
  13.    
  14.     Set db = DBEngine(0)(0)
  15.    
  16.     ' First we verify the Property Exists to avoid an error
  17.     If ExistsDBProperty(strPropName) = False Then
  18.         Set prp = db.CreateProperty(strPropName, dbText, strPropValue)
  19.         db.Properties.Append prp
  20.     Else
  21.         Set prp = db.Properties(strPropName)
  22.         prp.Value = strPropValue
  23.         MsgBox "DBProperty " & strPropName & " already exists.        " _
  24.             & vbCrLf & vbCrLf & "Property value was set." _
  25.             , vbExclamation
  26.     End If
  27.    
  28.     CreateDBStrProp = True
  29.    
  30. Exit_CreateDBStrProp:
  31.     Set prp = Nothing
  32.     Set db = Nothing
  33.     Exit Function
  34.  
  35. Err_CreateDBStrProp:
  36.     CreateDBStrProp = False
  37.     MsgBox "Error " & Err.Number & " (" & Err.Description & ")" & _
  38.     " In procedure CreateDBStrProp"
  39.     Resume Exit_CreateDBStrProp
  40. End Function



Get the Value of a Custom Database Property


textLine number Off | Hide | Select all
  1. '---------------------------------------------------------------------------------------
  2. ' Procedure : GetDBPropValue
  3. ' Purpose   : Returns the Property Value of the named property(strPropName)
  4. ' Arguments : strPropName As String-the Property Name
  5. '---------------------------------------------------------------------------------------
  6.  
  7. Function GetDBPropValue(strPropName As String) As Variant
  8. On Error GoTo Err_GetDBPropValue
  9.  
  10.     Dim db As DAO.Database
  11.     Dim prp As Property
  12.    
  13.     Set db = DBEngine(0)(0)
  14.    
  15.     If ExistsDBProperty(strPropName) = False Then
  16.         MsgBox "DBProperty """ & strPropName & """ does not exist.        " _
  17.             , vbExclamation
  18.     Else
  19.         Set prp = db.Properties(strPropName)
  20.        
  21.         GetDBPropValue = prp.Value
  22.         Debug.Print GetDBPropValue
  23.     End If
  24.      
  25. Exit_GetDBPropValue:
  26.     Set prp = Nothing
  27.     Set db = Nothing
  28.     Exit Function
  29.  
  30. Err_GetDBPropValue:
  31.     MsgBox "Error " & Err.Number & " (" & Err.Description & ")" & _
  32.     " In procedure GetDBPropValue"
  33.     Resume Exit_GetDBPropValue
  34. End Function



List All Custom Database Properties and Values


When you create a Custom Database Property it is added to the Collection of "BuiltIn" Database Properties. If your code produces a list of Database Properties it will show both the Built-In Properties and your Custom Properties. There is another collection of Custom Database properties called "UserDefined" Properties. You have to use different code to list these Properties.

textLine number Off | Hide | Select all
  1. '---------------------------------------------------------------------------------------
  2. ' Procedure : ListDBPropsAll
  3. ' Purpose   : List all "BuiltIn" and Custom Database Properties-but not "UserDefined"
  4. '---------------------------------------------------------------------------------------
  5.  
  6. Function ListDBPropsAll()
  7. On Error Resume Next ' An error occurs whenever this is run
  8.  
  9.     Dim db As DAO.Database
  10.     Dim i As Long
  11.    
  12.     Set db = DBEngine(0)(0)
  13.      
  14.     For i = 0 To db.Properties.Count - 1
  15.         If db.Properties(i).Name = "DesignMasterID" Then
  16.             ' Causes an error or long delay so skip it
  17.         Else
  18.             Debug.Print db.Properties(i).Name _
  19.             & " = " & db.Properties(i).Value
  20.         End If
  21.     Next i
  22.  
  23. Exit_ListDBProps:
  24.     Set db = Nothing
  25.     Exit Function
  26. End Function



Set the Value of a Custom Database Property


You will probably at some point need to change your Property's Value. This is how you can do it.

textLine number Off | Hide | Select all
  1. '---------------------------------------------------------------------------------------
  2. ' Procedure : SetDBPropValue
  3. ' Purpose   : Set the string Property Value of the named property(strPropName)
  4. ' Arguments : strPropName As String-the name of the Property
  5. '           : varPropValue As Variant-the Property Value to be set
  6. '---------------------------------------------------------------------------------------
  7. Function SetDBPropValue(strPropName As String, varPropValue As Variant) As Boolean
  8. On Error GoTo Err_SetDBPropValue
  9.  
  10.     Dim db As DAO.Database
  11.     Dim prp As Property
  12.    
  13.     Set db = DBEngine(0)(0)
  14.     If ExistsDBProperty(strPropName) = True Then
  15.         Set prp = db.Properties(strPropName)
  16.        
  17.         prp.Value = varPropValue
  18.     Else
  19.         Set prp = db.CreateProperty(strPropName, dbText, varPropValue)
  20.         db.Properties.Append prp
  21.  
  22.         MsgBox "DBProperty " & strPropName & " has been created.        " _
  23.             & vbCrLf & vbCrLf & "Property value was set." _
  24.             , vbExclamation
  25.     End If
  26.    
  27.     If prp.Value = varPropValue Then
  28.         SetDBPropValue = True
  29.     Else
  30.         SetDBPropValue = False
  31.     End If
  32.        
  33.     Debug.Print prp.Name & " = " & prp.Value
  34.    
  35. Exit_SetDBPropValue:
  36.     Set prp = Nothing
  37.     Set db = Nothing
  38.     Exit Function
  39.  
  40. Err_SetDBPropValue:
  41.     MsgBox "Error " & Err.Number & " (" & Err.Description & ")" & _
  42.     " In procedure SetDBPropValue"
  43.     Resume Exit_SetDBPropValue
  44. End Function



Delete a Custom Database Property


textLine number Off | Hide | Select all
  1. '---------------------------------------------------------------------------------------
  2. ' Procedure : DBPropDelete
  3. ' Purpose   : Delete a Custom Database Property-"Built In" Database Properties cannot
  4. '           : be deleted. A custom error message will display if attempted.
  5. ' Arguments : strPropName As String-the Name of the Property to be deleted
  6. '---------------------------------------------------------------------------------------
  7.  
  8. Function DBPropDelete(strPropName As String) As Boolean
  9. On Error GoTo Err_DBPropDelete
  10.  
  11.     Dim db As DAO.Database
  12.    
  13.     Set db = DBEngine(0)(0)
  14.    
  15.     If ExistsDBProperty(strPropName) = True Then
  16.         db.Properties.Delete strPropName
  17.     Else
  18.         MsgBox "Property does not exist and cannot be deleted.    " _
  19.             , vbExclamation
  20.         DBPropDelete = False
  21.         GoTo Exit_DBPropDelete
  22.     End If
  23.    
  24.     If ExistsDBProperty(strPropName) = False Then
  25.         DBPropDelete = True
  26.     Else
  27.         DBPropDelete = False
  28.     End If
  29.  
  30. Exit_DBPropDelete:
  31.     Set db = Nothing
  32.     Exit Function
  33.  
  34. Err_DBPropDelete:
  35.     Debug.Print (Err.Description & " " & Err.Number & _
  36.     " In procedure DBPropDelete")
  37.    
  38.     If Err.Number = 3384 Then
  39.    
  40.         MsgBox "        An error has occurred." _
  41.         & vbCrLf & vbCrLf & "Built in DB Properties Cannot be Deleted       " _
  42.         , vbExclamation, "                      Operation Failed"
  43.     End If
  44.     Resume Exit_DBPropDelete
  45. End Function



Determine if a Custom Database Property Exists


This code is very helpful to avoid an error should you try to access a property that does not exist.

textLine number Off | Hide | Select all
  1. '---------------------------------------------------------------------------------------
  2. ' Procedure : ExistsDBProperty
  3. ' Purpose   : Determine if a Database Property Exists
  4. ' Arguments : strPropName As String-the Property Name
  5. ' Example   : If ExistsDBProperty("MyProperty") = True Then . . .
  6. '---------------------------------------------------------------------------------------
  7.  
  8. Function ExistsDBProperty(strPropName As String) As Boolean
  9. On Error Resume Next
  10.  
  11.     Dim db As DAO.Database
  12.     Dim prp As DAO.Property
  13.    
  14.     Set db = DBEngine(0)(0)
  15.     Set prp = db.Properties(strPropName)
  16.    
  17.     If Not prp Is Nothing Then
  18.         ExistsDBProperty = True
  19.     Else
  20.         ExistsDBProperty = False
  21.     End If
  22.    
  23.     Set prp = Nothing
  24.     Set db = Nothing
  25.    
  26. End Function



Create the StartupForm Custom Database Property


textLine number Off | Hide | Select all
  1. '---------------------------------------------------------------------------------------
  2. ' Procedure : CreateStartupFormProp
  3. ' Purpose   : In order to add, delete, or change the Starup Form with code you must  
  4. '           : first create a custom property named "StartupForm" As dbTExt
  5. ' Arguments : Optional strFormName As String - The name of the Form - Optional
  6. '---------------------------------------------------------------------------------------
  7. Function CreateStartupFormProp(Optional strFormName As String) As Boolean
  8. On Error GoTo Err_CreateStartupFormProp
  9.  
  10.     Dim db As DAO.Database
  11.     Dim prp As Property
  12.  
  13.     Set db = DBEngine(0)(0)
  14.    
  15.     If ExistsDBProperty("StartupForm") = False Then
  16.         If Len(strFormName & vbNullString) = 0 Then
  17.             Set prp = db.CreateProperty("StartupForm", dbText)
  18.             db.Properties.Append prp
  19.            
  20.             MsgBox "                     The StartupForm Property was Created. " _
  21.                 & vbCrLf & vbCrLf & _
  22.                 " There was no startup Form name. A startup form was not set.    "
  23.         Else
  24.             Set prp = db.CreateProperty("StartupForm", dbText, strFormName)
  25.             db.Properties.Append prp
  26.              MsgBox "                           The Property already exists. " _
  27.                 & vbCrLf & vbCrLf & _
  28.                 " There was no startup Form name. A startup form was not set.    "
  29.                
  30.             CreateStartupFormProp = False
  31.             GoTo Exit_CreateStartupFormProp
  32.         End If
  33.     Else
  34.         If Len(strFormName & vbNullString) = 0 Then
  35.              MsgBox "                The StartupForm Property already exists. " _
  36.                 & vbCrLf & vbCrLf & _
  37.                 " There was no startup Form name. A startup form was not set.    "
  38.                
  39.                 CreateStartupFormProp = False
  40.                 GoTo Exit_CreateStartupFormProp
  41.             Else
  42.                 Set prp = db.Properties("StartupForm")
  43.                 prp.Value = strFormName
  44.                
  45.                 MsgBox "DBProperty " & "StartupForm" & " already exists.        " _
  46.                     & vbCrLf & vbCrLf & "The startup Form was set." _
  47.                     , vbExclamation
  48.                    
  49.                 CreateStartupFormProp = False
  50.                 GoTo Exit_CreateStartupFormProp
  51.             End If
  52.     End If
  53.    
  54.     CreateStartupFormProp = True
  55.  
  56. Exit_CreateStartupFormProp:
  57.     Set prp = Nothing
  58.     Set db = Nothing
  59.     Exit Function
  60.  
  61. Err_CreateStartupFormProp:
  62.     CreateStartupFormProp = False
  63.     MsgBox "Error " & Err.Number & " (" & Err.Description & ")" & _
  64.     " In procedure CreateStartupFormProp"
  65.     Resume Exit_CreateStartupFormProp
  66. End Function



Create a Custom Database Version Property


textLine number Off | Hide | Select all
  1. '---------------------------------------------------------------------------------------
  2. ' Procedure : CreateAppVersionProp(strVersion As String)
  3. ' Purpose   : Create a Custom Database Version Property named "AppVersion"
  4. ' Arguments : strVersion As String-The Version of the Application
  5. ' Example   : Call CreateAppVersionProp("Version 1.0")
  6. '---------------------------------------------------------------------------------------
  7.  
  8. Function CreateAppVersionProp(strVersion As String) As Boolean
  9. On Error GoTo Err_CreateAppVersionProp
  10.  
  11.     Dim db As DAO.Database
  12.     Dim prp As Property
  13.    
  14.     Set db = DBEngine(0)(0)
  15.    
  16.     If ExistsDBProperty("AppVersion") = False Then
  17.         Set prp = db.CreateProperty("AppVersion", dbText, strVersion)
  18.         db.Properties.Append prp
  19.     Else
  20.         Set prp = db.Properties("AppVersion")
  21.         prp.Value = strVersion
  22.         MsgBox "DBProperty AppVersion already exists.        " _
  23.             & vbCrLf & vbCrLf & "Version value was set." _
  24.             , vbExclamation
  25.     End If
  26.    
  27.     CreateAppVersionProp = True
  28.    
  29. Exit_CreateAppVersionProp:
  30.     Set prp = Nothing
  31.     Set db = Nothing
  32.     Exit Function
  33.  
  34. Err_CreateAppVersionProp:
  35.     CreateAppVersionProp = False
  36.     MsgBox "Error " & Err.Number & " (" & Err.Description & ")" & _
  37.     " In procedure CreateAppVersionProp"
  38.     Resume Exit_CreateAppVersionProp
  39. End Function



Set the Value of the Custom Database Version Property


textLine number Off | Hide | Select all
  1. '---------------------------------------------------------------------------------------
  2. ' Procedure : SetAppVersion(strVersion As String)
  3. ' Purpose   : Set the Version of the AppVersion Property
  4. ' Arguments : strVersion As String-The Version of the Application
  5. ' Example   : Call SetAppVersion("Version 2.1")
  6. '---------------------------------------------------------------------------------------
  7.  
  8. Function SetAppVersion(strVersion As String) As Boolean
  9. On Error GoTo Err_SetAppVersion
  10.     Dim db As DAO.Database
  11.     Dim prop As Property
  12.    
  13.     Set db = DBEngine(0)(0)
  14.    
  15.     If ExistsDBProperty("AppVersion") = True Then
  16.         Set prop = db.Properties("AppVersion")
  17.         prop.Value = strVersion
  18.     Else
  19.         Set prop = db.CreateProperty("AppVersion", dbText, strVersion)
  20.         db.Properties.Append prop
  21.        
  22.         MsgBox "DBProperty AppVersion was created.        " _
  23.             & vbCrLf & vbCrLf & "Version value was set." _
  24.             , vbExclamation
  25.     End If
  26.    
  27.     Debug.Print prop.Name & " = " & prop.Value
  28.    
  29.     SetAppVersion = True
  30.  
  31. Exit_SetAppVersion:
  32.     Set prop = Nothing
  33.     Set db = Nothing
  34.     Exit Function
  35.  
  36. Err_SetAppVersion:
  37.     SetAppVersion = False
  38.     MsgBox "Error " & Err.Number & " (" & Err.Description & ")" & _
  39.     " In procedure SetAppVersion"
  40.     Resume Exit_SetAppVersion
  41. End Function



Create a Custom Database Copyright Property


textLine number Off | Hide | Select all
  1. '---------------------------------------------------------------------------------------
  2. ' Procedure : CreateCopyright(strStartYear as String, strOwner As String)
  3. ' Purpose   : Create and set Copyright Property
  4. ' Arguments : strStartYear as String-Example: "2006"
  5. '           : strOwner As String-Company or Owner Name
  6. '---------------------------------------------------------------------------------------
  7.  
  8. Function CreateCopyright(strStartYear As String, strOwner As String) As Boolean
  9. On Error GoTo Err_CreateCopyright
  10.    
  11.     Dim db As DAO.Database
  12.     Dim prp As Property
  13.     Dim strValue As String
  14.  
  15.     Set db = DBEngine(0)(0)
  16.  
  17.     strValue = "(C) " & strStartYear & "-" & Year(Now) & " " & strOwner
  18.  
  19.     If ExistsDBProperty("Copyright") = True Then
  20.         Set prp = db.Properties("Copyright")
  21.         prp.Value = strValue
  22.        
  23.         MsgBox "Copyright Property already exists.        " _
  24.         & vbCrLf & vbCrLf & "Copyright value was set." _
  25.         , vbExclamation
  26.     Else
  27.         Set prp = db.CreateProperty("Copyright", dbText, strValue)
  28.         db.Properties.Append prp
  29.     End If
  30.  
  31.     Debug.Print prp.Name & " = " & prp.Value
  32.     CreateCopyright = True
  33.  
  34. Exit_CreateCopyright:
  35.     Set prp = Nothing
  36.     Set db = Nothing
  37.     Exit Function
  38.  
  39. Err_CreateCopyright:
  40.     CreateCopyright = False
  41.     MsgBox "Error " & Err.Number & " (" & Err.Description & ")" & _
  42.     " In procedure CreateCopyright"
  43.     Resume Exit_CreateCopyright
  44. End Function



Set the Custom Database Copyright Property Value


textLine number Off | Hide | Select all
  1. '---------------------------------------------------------------------------------------
  2. ' Procedure : SetCopyright(strStartYear as String, strOwner As String)
  3. ' Purpose   : Update Copyright Property
  4. ' Arguments : strStartYear as String-Example: "2006"
  5. '           : strOwner As String-Company or Owner Name
  6. '---------------------------------------------------------------------------------------
  7.  
  8. Function SetCopyright(strStartYear As String, strOwner As String) As Boolean
  9. On Error GoTo Err_SetCopyright
  10.    
  11.     Dim db As DAO.Database
  12.     Dim prp As Property
  13.     Dim strValue As String
  14.  
  15.     Set db = DBEngine(0)(0)
  16.  
  17.     strValue = "(C) " & strStartYear & "-" & Year(Now) & " " & strOwner
  18.  
  19.     If ExistsDBProperty("Copyright") = False Then
  20.         Set prp = db.CreateProperty("Copyright", dbText, strValue)
  21.         db.Properties.Append prp
  22.          
  23.         MsgBox "Copyright Property was created.        " _
  24.             & vbCrLf & vbCrLf & "Copyright value was set." _
  25.             , vbExclamation
  26.     Else
  27.         Set prp = db.Properties("Copyright")
  28.         prp.Value = strValue
  29.     End If
  30.  
  31.     Debug.Print prp.Name & " = " & prp.Value
  32.    
  33.     SetCopyright = True
  34.  
  35. Exit_SetCopyright:
  36.     Set prp = Nothing
  37.     Set db = Nothing
  38.     Exit Function
  39.  
  40. Err_SetCopyright:
  41.     SetCopyright = False
  42.     MsgBox "Error " & Err.Number & " (" & Err.Description & ")" & _
  43.     " In procedure SetCopyright"
  44.     Resume Exit_SetCopyright
  45. End Function


As you can see you can use these Properties for a variety of needs. If you have a very important Global Variable you cannot afford to loose you can always save it as a Custom Database Property.

You can learn more about working with Custom Database Properties at http://msdn.microsoft.com/en-us/library/bb258165.aspx

You can learn more about setting Database Startup Properties with code at http://msdn.microsoft.com/en-us/library/aa200349.aspx You can also search VBA Help for "Startup Properties."

Submitted by hunterpaw

617 Rating: 4.5/5 (8 votes cast)

Retrieved from "http://wiki.lessthandot.com/index.php/Custom_Database_Properties_Creation_and_Use"

Powered by MediaWiki GNU Free Documentation License 1.2
Valid XHTML | Valid CSS