Database Properties : Date Created vs DateCreated

  • Thread starter Thread starter Tintin
  • Start date Start date
T

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 ?
Click to expand...

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
 
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
 
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
 
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.
 
Dear Sylvain Lafontaine,

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

Regards,
Tintin
 
Back
Top