Database Properties : Date Created vs DateCreated

[Tintin]

Dear All,

I was trying to get my database propeties using VBA Code as follow :

Dim fs, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile("FileName")
zDateCreated = f.DateCreated
zDateModified = f.dateLastModified

MsgBox Created : & zDateCreated & " Modified : " & zDateModified

It works fine, but the result of Msgbox makes me curious why zDateCreated and
zDateModified is not the same when I check through File > Database Properties

General ?

1. In the MsgBox shows (yy/mm/dd hh:nn:ss) :
Created : 06/12/07 10:21:44 Modified : 06/12/07 10:22:00

2. In File > Database Properties > General (yy/mm/dd hh:nn:ss)
shows:
Created : 07/01/06 02:43:02 Modified : 07/01/05 22:48:16

Please someone tell me why? How can I get (through VBA Code) the same
Database Properties when I click File > Database Properties > General?

Thanks,
Tintin

 

[Sylvain Lafontaine]

The database object has a Properties collection, maybe you will find what
you are searching there. Here is an exemple of code for setting and getting
properties into this collection:


Private Const cerrPropertyNotFound As Integer = 3270

Public Sub SetProperty(ByVal strPropName As String, _
ByVal varPropType As Integer, _
ByVal varPropValue As Variant)

Const cProcedureName As String = "SetProperty"
On Error GoTo Err_Handler

Dim db As DAO.Database
Dim prp As DAO.Property

Set db = DAODatabase()

Dim i
For i = 0 To db.Properties.Count - 1
If (db.Properties(i).name = strPropName) Then
db.Properties(strPropName).Value = varPropValue
GoTo Exit_Sub
End If
Next

Set prp = db.CreateProperty(strPropName, varPropType, varPropValue)
db.Properties.Append prp
Set prp = Nothing

Exit_Sub:
On Error GoTo 0
' Set prp = Nothing
Set db = Nothing
Exit Sub

Err_Handler:
' Err_Handler: utilisée dans l'ancienne version.

Select Case err
Case cerrPropertyNotFound
Set prp = db.CreateProperty(strPropName, varPropType, varPropValue)
db.Properties.Append prp
Set prp = Nothing
Case Else
' Call LogError(Err.Number, Err.Description, cModuleName &
cProcedureName)
End Select

Resume Exit_Sub

End Sub


Public Function GetProperty(ByVal strPropName As String, _
ByRef strPropValue As Variant) As Boolean

Const cProcedureName As String = "GetProperty"
On Error GoTo Err_Handler
Dim db As DAO.Database

Set db = DAODatabase()

Dim i
For i = 0 To db.Properties.Count - 1
If (db.Properties(i).name = strPropName) Then
strPropValue = db.Properties(strPropName)
GetPropertyMDB = True
GoTo Exit_Function
End If
Next

GetProperty = False

Exit_Function:
On Error GoTo 0
Set db = Nothing
Exit Function

Err_Handler:
GetProperty = False

Select Case err
Case cerrPropertyNotFound
Case Else
' Call LogError(Err.Number, Err.Description, cModuleName &
cProcedureName)
End Select

Resume Exit_Function

End Function

 

[Tintin via AccessMonster.com]

Dear Sylvain Lafontaine,

Thanks for your kind and prompt response.

I have copied the code and there is error message says : Argument not
optional.
Can you please tell me why?

Thanks again,
Tintin

 

[Sylvain Lafontaine]

Oups, sorry, I should have make a simple verification before shipping this
code. This is the code that I use to set or retrieve my own custom
properties. With a simple loop, you can retrieve all the properties:

Function show_properties()

Dim db As DAO.Database

Set db = DBEngine(0)(0) ' or: Set db = CurrentDb()

Dim i
On Error Resume Next

For i = 0 To db.Properties.Count - 1
Debug.Print db.Properties(i).Name & ": " & db.Properties(i).Value
Next

End Function


However, for the custom properties that are set or displayed in the menu,
you must use the collection Databases.Documents!UserDefined:

Function show_custom_properties()

Dim db As Database
Dim doc As Document
Dim prp As Property

Set db = CurrentDb
Set doc = db.Containers!Databases.Documents!UserDefined

Dim i

For i = 0 To doc.Properties.Count - 1
Debug.Print doc.Properties(i).Name & ": " & doc.Properties(i).Value
Next

End Function


This is the function that you would want to use in your case. You will find
other information in the following reference:
http://support.microsoft.com/kb/178745/EN-US/ . I add added the line "On
Error Resume Next" in the first function become the value for some of the
properties in the first collection are undefined.

 

[Tintin via AccessMonster.com]

Dear Sylvain Lafontaine,

Thank you very much! It works just the way I wanted.

Regards,
Tintin