code: AddFieldToTable, AddDateUserToTables
---
Hi Connie,
Add these fields to every table:
UserIDc, long integer -- userID who created record
UserIDm, long integer -- userID who modified record
DateCreated, date/time -- date/time record was created
DateModified, date/time -- date/time record was modified
DateCreated can have a default valut --> =Now() and it will get filled
automatically each time a record is created
UserIDc can ber filled on the form BeforeInsert event -- can be a lookup
for the current user on the front-end
DateModified and UserIDm will be filled on the form BeforeUpdate event
'~~~~~~~~~~~~~~~~
'example showing how to add certain fields to a particular table
'~~~~~~~~~~~~~~~~
Sub testaddFieldToTable()
AddFieldToTable "test", "AutoID", dbLong, , "*AN*"
AddFieldToTable "test", "SomeID", dbLong, , "*Null*"
AddFieldToTable "test", "ImportLog", dbText, 255
AddFieldToTable "test", "DateCreated", dbDate, , "*Now*"
End Sub
'~~~~~~~~~~~~~~~~
'example showing how to add the same fields
'to every user table in the database
'~~~~~~~~~~~~~~~~
Sub AddDateUserToTables()
Dim tdf As dao.TableDef, i As Integer
i = 1
For Each tdf In CurrentDb.TableDefs
If Left(tdf.Name, 4) <> "MSys" Then
AddFieldToTable tdf.Name, _
"UserIDc", dbLong, , "*Null*"
AddFieldToTable tdf.Name, _
"UserIDm", dbLong, , "*Null*"
AddFieldToTable tdf.Name, _
"DateCreated", dbDate, , "*Now*"
AddFieldToTable tdf.Name, _
"DateModified", dbDate
i = i + 1
End If
Next tdf
DoEvents
Set tdf = Nothing
MsgBox "Added fields to " & i & " tables", , "Done"
End Sub
'~~~~~~~~~~~~~~~~
put the following function in a general module:
'~~~~~~~~~~~~~~~~
Function AddFieldToTable( _
pTablename As String, _
pFldname As String, _
pDataType As Integer, _
Optional pFieldSize As Integer, _
Optional pDefaultValue As String) _
As Boolean
'written by Crystal
'strive4peace2007 at yahoo.com
'PARAMETERS
'pTablename --> name of table to modify structure of
'pFldname --> name of field to create
'pDataType --> dbText, dbLong, dbDate, etc
'pFieldSize --> length for text fields
'pDefaultValue --> *AN* = autonumber
' --> *Null* --> DefaultValue = Null
' --> *Now* --> DefaultValue = Now()
' --> otherwise whatever is specified
'NEEDS Reference to
'a Microsoft DAO Library
On Error GoTo Proc_Err
Dim db As Database, Fld As dao.Field
'you could make this a passed parameter
' and open another database
Set db = CurrentDb
With db.TableDefs(pTablename)
Select Case pDataType
Case dbText
'Text
Set Fld = .CreateField(pFldname, _
pDataType, pFieldSize)
Case Else
'Long Integer, Date, etc
Set Fld = .CreateField(pFldname, pDataType)
End Select
If Len(Nz(pDefaultValue, "")) > 0 Then
Select Case pDefaultValue
Case "*AN*"
'Autonumber
Fld.Attributes = dbAutoIncrField
Case "*Null*"
'Null for DefaultValue
Fld.DefaultValue = "Null"
Case "*Now*"
'Now for DefaultValue
Fld.DefaultValue = "=Now()"
Case Else
'Now for DefaultValue
Fld.DefaultValue = "=" & pDefaultValue
End Select
End If
If pDataType = dbText Then
Fld.AllowZeroLength = True
End If
.Fields.Append Fld
End With
db.TableDefs.Refresh
DoEvents
' MsgBox "Added --> " & pFldname _
& " to --> " & pTablename, , "Done"
AddFieldToTable_exit:
On Error Resume Next
Set Fld = Nothing
Set db = Nothing
Exit Function
Proc_Err:
'if the field is already there, ignore error
If Err = 3191 Then Resume Next
MsgBox Err.Description, , _
"ERROR " & Err.Number & " AddFieldToTable"
'press F8 to step through code and fix problem
'comment next line after debugged
Stop: Resume
Resume AddFieldToTable_exit
End Function
'~~~~~~~~~~~~~~~~
Warm Regards,
Crystal
*
have an awesome day
*
MVP Access
Remote Programming and Training
strive4peace2006 at yahoo.com
*
