Checking Access Database Properties using VBA

Recently I had a need to set up some properties for a database I've been working on. Rather than doing it the easy way (i.e. setting them manually), I decided to write a few procedures to check and set different properties. Note that these are the file properties (Title, Subject, Author, Manager, Company, etc) found by going to File » Database Properties, not the properties found at Tools » Startup. The difference being that database properties are part of the Properties Collection, whereas the file properties are part of the Documents Collection.

All of the following procedures are based on the code found here (originally from the MS newsgroups but I couldn't find a proper link).

Check if a file property already exists

Function FilePropertyExists(propertyName As String) As Boolean

  Dim dbs As DAO.Database
  Dim cnt As DAO.Container
  Dim doc As DAO.Document
  Dim prp As DAO.Property

  Set dbs = GetCurrentDB
  Set cnt = dbs.Containers!Databases
  Set doc = cnt.Documents!SummaryInfo
  Set prp = doc.Properties(propertyName)

  If Not prp Is Nothing Then
    FilePropertyExists = True
  End If

End Function

If it exists, set it

Function SetFileProperty(propertyName As String, _
    propertyValue As String)

  Dim dbs As DAO.Database
  Dim cnt As DAO.Container
  Dim doc As DAO.Document
  Dim prp As DAO.Property

  Set dbs = GetCurrentDB
  Set cnt = dbs.Containers!Databases
  Set doc = cnt.Documents!SummaryInfo
  Set prp = doc.Properties(propertyName)

  If Not prp Is Nothing Then
    prp.Value = propertyValue
  End If

End Function

Otherwise, add it and set its value

Function AddFileProperty(propertyName As String, _
     propertyType As DataTypeEnum, propertyValue As String)

  Dim dbs As Database
  Dim cnt As Container
  Dim doc As Document
  Dim prp As Property

  Set dbs = GetCurrentDB
  Set cnt = dbs.Containers!Databases
  Set doc = cnt.Documents!SummaryInfo
  Set prp = _
    doc.CreateProperty(propertyName, propertyType, propertyValue)

  doc.Properties.Append prp

End Function

And whenever we want, check the value if we need it

Function GetFileProperty(propertyName As String) As String

  Dim dbs As DAO.Database
  Dim cnt As DAO.Container
  Dim doc As DAO.Document
  Dim prp As DAO.Property

  Set dbs = GetCurrentDB
  Set cnt = dbs.Containers!Databases
  Set doc = cnt.Documents!SummaryInfo
  Set prp = doc.Properties(propertyName)

  GetFileProperty = prp.Value

End Function