Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
Create/Check various attributes in a database using DAO
Database
[red]In DAO you can use the following function to check various attributes in a database:[/red]
Please note that myDB should be an opened database!
Public Function fnCheckTable(strTable As String, strCheck As String, intAttr)
' strCheck = name of attribute to check
' intAttr = integer pointing to attribute
' 0 - field
' 1 - index
' 2 - relation
' 3 - tabledef
' 4 - allowzerolength = true
Dim td As TableDef
Dim Idx As Index
Dim fld As Field
Dim Rel As Relation
Dim Ok As Boolean
Dim n As Integer
Ok = False
n = 0
Select Case intAttr
Case 0 'Field
Set td = MyDB.TableDefs(strTable)
For Each fld In td.Fields
If td.Fields
.Name = strCheck Then Ok = True
n = n + 1
Next
Case 1 'Index
Set td = MyDB.TableDefs(strTable)
For Each Idx In td.Indexes
If td.Indexes.Name = strCheck Then Ok = True
n = n + 1
Next
Case 2 'Relation
For Each Rel In MyDB.Relations
If MyDB.Relations.Name = strCheck Then Ok = True
n = n + 1
Next
Case 3 'Tabledefs
For Each td In MyDB.TableDefs
If UCase(MyDB.TableDefs.Name) = UCase(strCheck) Then Ok = True
n = n + 1
Next
Case 4 'AllowZeroLength property
Set td = MyDB.TableDefs(strTable)
For Each fld In td.Fields
If td.Fields.Name = strCheck Then
td.Fields.AllowZeroLength = True
Ok = True
End If
n = n + 1
Next
td.Fields.Refresh 'if this results in an error then something did go wrong!
End Select
fnCheckTable = Ok
End Function
[red]Some samples of how to call the function (I omitted the declarations of variables):[/red]
'Check if the table is already upgraded
Set td = MyDB.TableDefs("Pricing")
'create the necessary fields if they don't exist
Ok = fnCheckTable("Pricing", "PackageID", 0)
If Not Ok Then
Set fld = td.CreateField("PackageID", dbLong)
td.Fields.Append fld
End If
Ok = fnCheckTable("Pricing", "RecNum", 0)
If Not Ok Then
Set fld = td.CreateField("RecNum", dbInteger)
td.Fields.Append fld
End If
'Create the index if it doesn't exist
Ok = fnCheckTable("Pricing", "PricIdx", 1)
If Not Ok Then
'Create the index (two fields)
Set NewIdx = td.CreateIndex("PricIdx")
NewIdx.Primary = True
NewIdx.IgnoreNulls = True
NewIdx.Unique = True
Set NewFld = NewIdx.CreateField("PackageID")
NewFld.Required = True
NewIdx.Fields.Append NewFld
Set NewFld = NewIdx.CreateField("RecNum")
NewFld.Required = True
NewIdx.Fields.Append NewFld
td.Indexes.Append NewIdx
td.Indexes.Refresh
End If
Please note that myDB should be an opened database!
Public Function fnCheckTable(strTable As String, strCheck As String, intAttr)
' strCheck = name of attribute to check
' intAttr = integer pointing to attribute
' 0 - field
' 1 - index
' 2 - relation
' 3 - tabledef
' 4 - allowzerolength = true
Dim td As TableDef
Dim Idx As Index
Dim fld As Field
Dim Rel As Relation
Dim Ok As Boolean
Dim n As Integer
Ok = False
n = 0
Select Case intAttr
Case 0 'Field
Set td = MyDB.TableDefs(strTable)
For Each fld In td.Fields
If td.Fields
.Name = strCheck Then Ok = Truen = n + 1
Next
Case 1 'Index
Set td = MyDB.TableDefs(strTable)
For Each Idx In td.Indexes
If td.Indexes
.Name = strCheck Then Ok = Truen = n + 1
Next
Case 2 'Relation
For Each Rel In MyDB.Relations
If MyDB.Relations
.Name = strCheck Then Ok = Truen = n + 1
Next
Case 3 'Tabledefs
For Each td In MyDB.TableDefs
If UCase(MyDB.TableDefs
.Name) = UCase(strCheck) Then Ok = Truen = n + 1
Next
Case 4 'AllowZeroLength property
Set td = MyDB.TableDefs(strTable)
For Each fld In td.Fields
If td.Fields
.Name = strCheck Thentd.Fields
.AllowZeroLength = TrueOk = True
End If
n = n + 1
Next
td.Fields.Refresh 'if this results in an error then something did go wrong!
End Select
fnCheckTable = Ok
End Function
[red]Some samples of how to call the function (I omitted the declarations of variables):[/red]
'Check if the table is already upgraded
Set td = MyDB.TableDefs("Pricing")
'create the necessary fields if they don't exist
Ok = fnCheckTable("Pricing", "PackageID", 0)
If Not Ok Then
Set fld = td.CreateField("PackageID", dbLong)
td.Fields.Append fld
End If
Ok = fnCheckTable("Pricing", "RecNum", 0)
If Not Ok Then
Set fld = td.CreateField("RecNum", dbInteger)
td.Fields.Append fld
End If
'Create the index if it doesn't exist
Ok = fnCheckTable("Pricing", "PricIdx", 1)
If Not Ok Then
'Create the index (two fields)
Set NewIdx = td.CreateIndex("PricIdx")
NewIdx.Primary = True
NewIdx.IgnoreNulls = True
NewIdx.Unique = True
Set NewFld = NewIdx.CreateField("PackageID")
NewFld.Required = True
NewIdx.Fields.Append NewFld
Set NewFld = NewIdx.CreateField("RecNum")
NewFld.Required = True
NewIdx.Fields.Append NewFld
td.Indexes.Append NewIdx
td.Indexes.Refresh
End If