Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
Sub Example()
'Requires Reference to DAO object model
Dim db As DAO.Database
Dim tbl As DAO.TableDef
Dim tbls As DAO.TableDefs
Dim fld As DAO.Field
Set db = CurrentDb()
Set tbls = db.TableDefs
For Each tbl In tbls
With tbl
Set fld = .CreateField("Created", dbDate)
fld.DefaultValue = "Now()" 'code not tested... may need Equal sign before
.Fields.Append fld
End
Next tbl
Set tbl = Nothing
Set tbls = Nothing
Set db = Nothing
End Sub
Public Sub addFields(tblName As String)
Dim strSql As String
Dim I As Integer
Dim colName As String
For I = 9 To 13
colName = "X" & I
strSql = "ALTER TABLE " & tblName & " ADD COLUMN " & colName & " Double"
CurrentDb.Execute strSql
Next I
End Sub
Public Sub addFieldDAO(tblName As String)
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim fldName As String
Dim db As DAO.Database
Dim I As Integer
Set db = CurrentDb
Set tdf = db.TableDefs(tblName)
For I = 1 To 13
fldName = "X" & I
Set fld = tdf.CreateField(fldName, dbDouble)
tdf.Fields.Append fld
Next I
End Sub
Public Sub addFieldDAO(tblName As String)
On Error GoTo errLabel
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim fldName As String
Dim db As DAO.Database
Dim I As Integer
Set db = CurrentDb
Set tdf = db.TableDefs(tblName)
For I = 9 To 13
fldName = "X" & I
Set fld = tdf.CreateField(fldName, dbDouble)
tdf.Fields.Append fld
Next I
Exit Sub
errLabel:
If Err.Number = 3191 Then
MsgBox "Field " & fldName & " already exists in " & tblName
Resume Next
Else
MsgBox Err.Number & " " & Err.Description
End If
End Sub
Public Sub loopTables()
Dim tdf As TableDef
Dim tdfName As String
For Each tdf In CurrentDb.TableDefs
tdfName = tdf.Name
'probably need another rule to check for non system tables
'that you do not want to add a field to
If Not Left(tdfName, 4) = "MSYS" Then
addFieldDAO tdfName
End If
Next tdf
End Sub