Date/Time format

  • Thread starter Thread starter Martin Dashper
  • Start date Start date
M

Martin Dashper

While creating a table, in code, using 'CreateTableDef' and
'CreateField', is it possible to set the format of Date/Time fields to
'ShortDate' or 'ShortTime'?

Martin Dashper
 
Yes, you can CreateProperty() on the Field object to create the Format
property. Format is a Text type property, and supports custom strings or the
built-in named formats such as "Short Time".

If the property is already present, it just needs a value assigned rather
than created, so the function below checks if the property exists, creates
it if necessary, and assigns the value. Assuming you already have the fld
reference in your table, just use:
Call SetPropertyDAO(fld, "Format", dbText, "Short Date")


Function SetPropertyDAO(obj As Object, strPropertyName As String, intType As
Integer, varValue As Variant, Optional strErrMsg As String) As Boolean
On Error GoTo ErrHandler
'Purpose: Set a property for an object, creating if necessary.
'Arguments: obj = the object whose property should be set.
' strPropertyName = the name of the property to set.
' intType = the type of property (needed for creating)
' varValue = the value to set this property to.
' strErrMsg = string to append any error message to.

If HasProperty(obj, strPropertyName) Then
obj.Properties(strPropertyName) = varValue
Else
obj.Properties.Append obj.CreateProperty(strPropertyName, intType,
varValue)
End If
SetPropertyDAO = True

ExitHandler:
Exit Function

ErrHandler:
strErrMsg = strErrMsg & obj.Name & "." & strPropertyName & " not set to
" & varValue & ". Error " & Err.Number & " - " & Err.Description & vbCrLf
Resume ExitHandler
End Function

Public Function HasProperty(obj As Object, strPropName As String) As Boolean
'Purpose: Return true if the object has the property.
Dim varDummy As Variant

On Error Resume Next
varDummy = obj.Properties(strPropName)
HasProperty = (Err.Number = 0)
End Function
 
Yes, you can CreateProperty() on the Field object to create the Format
property. Format is a Text type property, and supports custom strings or the
built-in named formats such as "Short Time".

If the property is already present, it just needs a value assigned rather
than created, so the function below checks if the property exists, creates
it if necessary, and assigns the value. Assuming you already have the fld
reference in your table, just use:
Call SetPropertyDAO(fld, "Format", dbText, "Short Date")
Click to expand...

After trying the code that you kindly supplied, I was still unable to
set the format of my Date/Time field to Short Date. So I created a
button with the following code on it and got the implied results:

Private Sub Test_Click()
Dim db As Database
Dim tdf As TableDef
Dim fld As Field

Set db = CurrentDb
Set tdf = db.CreateTableDef("MyTable")

Set fld = tdf.CreateField("DateField", dbDate)

' Uncommenting the next line gives error 3270 - Property not found
' fld.Properties("Format") = "Short Date"

' Uncommenting the next line gives error 3219 - Invalid operation
fld.Properties.Append fld.CreateProperty("Format", dbText, "Short Date")

tdf.Fields.Append fld
db.TableDefs.Append tdf
RefreshDatabaseWindow
End Sub

What am I doing wrong?

Martin Dashper.
 
Try appending the field to the table's Fields collection before you
CreateProperty(). I think the field will need to exist before you can assing
properties to it.

If you are creating the field, the error 3270 is correct: the property will
not exist until it is created, so you can drop that line.
 
I have found that if I open a recordset on a pre-existing table with a
date/time field whose Format is already set - and I navigate to gain
a current record - this field has the following extra properties,
compared with a date/time field whose Format is unset:

ColumnWidth, ColumnOrder, ColumnHidden, Format, IMEMode,
IMESentenceMode, GUID.

And I can change the value of Format to 'Short Date' or whatever. But
trying to append a Format property to a field that doesn't have one
set already, with:

fld.Properties.Append fld.CreateProperty("Format", dbText, "Short
Date"),

is considered an 'Invalid operation'.

-- Martin Dashper.
 
It is an invalid operation if the fld has not already been appended to the
Fields of the TableDef.
 
Thanks for your help, Allen. Taking your point on board, I reordered
my code as follows.

Private Sub btnTest_Click()
Dim db As Database
Dim tdf As TableDef
Dim fld As Field

Set db = CurrentDb
Set tdf = db.CreateTableDef("MyTable")
Set fld = tdf.CreateField("DateField", dbDate)

tdf.Fields.Append fld

fld.Properties.Append fld.CreateProperty("Format", dbText, "Short Date")

db.TableDefs.Append tdf
RefreshDatabaseWindow
End Sub

But the property-appending line still gives "Run-time error 3219:
Invalid operation." So I still don't see what I'm doing wrong.

Martin Dashper.
 
Martin, what I have always done is to create the table, and then create the
properties on the fields.

The example below shows how to loop through the fields on the table, and
standardize the properties you are likely to want to set. It sets
AllowZeroLength to No for text and memo fields, sets the Currency format for
Currency fields, removes that darned zero default value from numeric fields,
and sets the booleans to display as a check box.

Sub StandardProperties(strTableName As String)
'Purpose: Properties you always want set by default:
' TableDef: Subdatasheets off.
' Numeric fields: Remove Default Value.
' Currency fields: Format as currency.
' Yes/No fields: Display as check box. Default to No.
' Text/memo/hyperlink: AllowZeroLength off,
' UnicodeCompression on.
'Argument: Name of the table.
Dim db As DAO.Database 'Current database.
Dim tdf As DAO.TableDef 'Table nominated in argument.
Dim fld As DAO.Field 'Each field.
Dim strCaption As String 'Field caption.
Dim strErrMsg As String 'Responses and error messages.

'Initalize.
Set db = CurrentDb()
Set tdf = db.TableDefs(strTableName)

'Set the table's SubdatasheetName.
Call SetPropertyDAO(tdf, "SubdatasheetName", dbText, "[None]", _
strErrMsg)

For Each fld In tdf.Fields
'Handle the defaults for the different field types.
Select Case fld.Type
Case dbText, dbMemo 'Includes hyperlinks.
fld.AllowZeroLength = False
Call SetPropertyDAO(fld, "UnicodeCompression", dbBoolean, _
True, strErrMsg)
Case dbCurrency
Call SetPropertyDAO(fld, "Format", dbText, "Currency", _
strErrMsg)
Case dbLong, dbInteger, dbByte, dbDouble, dbSingle, dbDecimal
fld.DefaultValue = vbNullString
Case dbBoolean
Call SetPropertyDAO(fld, "DisplayControl", dbInteger, _
CInt(acCheckBox))
End Select
Next

'Clean up.
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
If Len(strErrMsg) > 0 Then
Debug.Print strErrMsg
Else
Debug.Print "Properties set for table " & strTableName
End If
End Sub

Function SetPropertyDAO(obj As Object, strPropertyName As String, intType As
Integer, varValue As Variant, Optional strErrMsg As String) As Boolean
On Error GoTo ErrHandler
'Purpose: Set a property for an object, creating if necessary.
'Arguments: obj = the object whose property should be set.
' strPropertyName = the name of the property to set.
' intType = the type of property (needed for creating)
' varValue = the value to set this property to.
' strErrMsg = string to append any error message to.

If HasProperty(obj, strPropertyName) Then
obj.Properties(strPropertyName) = varValue
Else
obj.Properties.Append obj.CreateProperty(strPropertyName, intType,
varValue)
End If
SetPropertyDAO = True

ExitHandler:
Exit Function

ErrHandler:
strErrMsg = strErrMsg & obj.Name & "." & strPropertyName & " not set to
" & varValue & ". Error " & Err.Number & " - " & Err.Description & vbCrLf
Resume ExitHandler
End Function

Public Function HasProperty(obj As Object, strPropName As String) As Boolean
'Purpose: Return true if the object has the property.
Dim varDummy As Variant

On Error Resume Next
varDummy = obj.Properties(strPropName)
HasProperty = (Err.Number = 0)
End Function
 
Hi Allen,

I tried your code, adding

Case dbDate
Call SetPropertyDAO(fld, "Format", dbText, "Short Date", _
strErrMsg)

to the select statement, and I am delighted to say that it worked
perfectly. Thank you very much for your kind help and for staying with
me on this one.

Martin.
 
Back
Top