Create Table, Add fields, Relationship and Link

[Melissa]

I have a frontend file named CustomerApp and backend file named CustomerData.
CustomerApp is at C:\Customer Database and CustomerData is at S:\Customer
Database. Could someone help me with the code to do the following:
1. Create a new table named TblCustomerContact in CustomerData
2. Add a field named CustomerContactID (autonumber) in TblCustomerContact
3. Add a field named CustomerID (Number-Long) in TblCustomerContact
4. Add a field named CustomerContact (Text) in TblCustomerContact
5. Create a relationship (Ref Integrity, Cascade Delete) between CustomerID in
TblCustomer and CustomerID in TblCustomerContact
6. Create a link to TblCustomerContact in CustomerApp

Thank you very much!

Melissa

[Filips Benoit]

This code is part of a utility to convert a Enumeration to a mapping. It
creates tables, fields, relations and transfer the data. This can help you
for your code!

Filip
Private Sub Enumeration2MAP(ByVal SourceTableName As String, _
ByVal SourceFieldName As String, _
ByVal TargetTableName As String, _
ByVal TargetFieldName As String, _
Optional ByVal strAllowedEnumWord As String =
"en", _
Optional ByVal DeleteSourceField As Boolean =
False)

'By Filips Benoit (be***********@pandora.be)

'These subroutine gets words from the field 'SourceFieldName' in table
'SourceTableName'
'Allowed delimiters: " " or "," or ";"
'Allowed enumeration-word: set word in variable 'strAllowedEnumWord'

'Saves the unique words in the field 'TargetFieldName' of table
'SourceTableName'
'Creates Mappingtable = 'Tbl_' & SourceTableName & "_" & SourceTableName &
"_MAP"
'Restores data by mapping Source and target according original data in
sourcefield.

On Error GoTo ErrHandling

'Declareren van variabelen
Dim intLoop1, intLoop2, intSourceRecordCount As Integer
Dim strCha, strTemp, strSourcePkeyName As String
Dim strEnumeration() As String
Dim intSourceID() As Long
Dim db As Database
Dim rsBron As Recordset
Dim rsTemp As Recordset
Dim rsMAP As Recordset
Dim rsDoel As Recordset
Dim tdf As TableDef
Dim fld, fld1, fld2, fldIndex, fldIndex2 As Field
Dim idx As Index

'1 Opslaan van Bronwaarden in array strEnumeration() en corresponderende PK
nl veld(0) in array intSourceID()
Set db = CurrentDb
Set rsBron = db.OpenRecordset(SourceTableName, dbOpenTable)
intSourceRecordCount = rsBron.RecordCount
ReDim strEnumeration(intSourceRecordCount)
ReDim intSourceID(intSourceRecordCount)
rsBron.MoveFirst
strSourcePkeyName = rsBron.Fields(0).Name
'Alle records van bron doorlopen en woordenlijsten opslaan
For intLoop1 = 1 To intSourceRecordCount
intSourceID(intLoop1) = rsBron.Fields(0).Value
strEnumeration(intLoop1) =
Trim(rsBron.Fields(SourceFieldName).Value)
rsBron.MoveNext
Next
'Bron sluiten
rsBron.Close
Set rsBron = Nothing

'2 Veld verwijderen uit brontabel
If DeleteSourceField Then
Set tdf = db.TableDefs(SourceTableName)
Set fld = tdf.Fields(SourceFieldName)
tdf.Fields.Delete fld.Name
tdf.Fields.Refresh
End If

'3 Maak Tijdelijke tabel met 2 velden
' Nieuwe tabel met twee velden maken.
Set tdf = db.CreateTableDef("TblTemp")
Set fld1 = tdf.CreateField("TempID", dbLong)
fld1.Attributes = fld1.Attributes + dbAutoIncrField
Set fld2 = tdf.CreateField("TempField2", dbText, 50)
' Velden toevoegen.
tdf.Fields.Append fld1
tdf.Fields.Append fld2
' Primaire-sleutelindex maken.
Set idx = tdf.CreateIndex("PrimaireSleutel")
Set fldIndex = idx.CreateField("TempID", dbLong)
' Indexvelden toevoegen.
idx.Fields.Append fldIndex
' Eigenschap Primary instellen.
idx.Primary = True
' Index toevoegen.
tdf.Indexes.Append idx
' TableDef-object toevoegen.
db.TableDefs.Append tdf
db.TableDefs.Refresh

'24 Woordenlijsten onderzoeken en geldige woorden opslaan in doel
Set rsTemp = db.OpenRecordset("TblTemp", dbOpenTable)

For intLoop1 = 1 To intSourceRecordCount 'Overloop alle woordenlijsten
For intLoop2 = 1 To Len(strEnumeration(intLoop1)) 'Overloop alle letters
in deze woordenlijsten
strCha = Mid$(strEnumeration(intLoop1), intLoop2, 1) 'bewaar
tijdelijk een teken
If InStr(" ,;", strCha) > 0 Then
If strTemp <> strAllowedEnumWord And Len(strTemp) > 1 Then '
onderzoek woord (=strTemp)
'geldig woord toevoegen
rsTemp.AddNew
rsTemp.Fields("TempField2").Value = strTemp
rsTemp.Update
Else
End If
strTemp = "" 'toegevoegd woord wissen in tijdelijke opslag
Else
strTemp = strTemp & strCha ' geen woordscheiding dus teken
toevoegen aan woord
End If
Next intLoop2
'einde woordenlijst zonder woordscheiding dus woord opslaan
rsTemp.AddNew
rsTemp.Fields("TempField2").Value = strTemp
rsTemp.Update
strTemp = "" ' einde woordenlijst dus woord = null
Next intLoop1
'Doel sluiten
rsTemp.Close
Set rsTemp = Nothing

'5 Maak Doeltabel tabel met 2 velden
' Nieuwe tabel met twee velden maken.
Set tdf = db.CreateTableDef(TargetTableName)
Set fld1 = tdf.CreateField(TargetTableName & "ID", dbLong)
fld1.Attributes = fld1.Attributes + dbAutoIncrField
Set fld2 = tdf.CreateField(TargetFieldName, dbText, 50)
' Velden toevoegen.
tdf.Fields.Append fld1
tdf.Fields.Append fld2
' Primaire-sleutelindex maken.
Set idx = tdf.CreateIndex("PrimaireSleutel")
Set fldIndex = idx.CreateField(TargetTableName & "ID", dbLong)
' Indexvelden toevoegen.
idx.Fields.Append fldIndex
' Eigenschap Primary instellen.
idx.Primary = True
' Index toevoegen.
tdf.Indexes.Append idx
' TableDef-object toevoegen.
db.TableDefs.Append tdf
db.TableDefs.Refresh

'6 Unieke waarden van TblTemp doorgeven naar Doeltabel
DoCmd.RunSQL ("INSERT INTO " & TargetTableName & " ( " & TargetFieldName
& " ) SELECT DISTINCT TblTemp.TempField2 FROM TblTemp;")

'7 Tijdelijke tabel wissen
db.TableDefs.Delete "TblTemp"

'8 Maak MAP-tabel met 2 velden
' Nieuwe tabel met twee velden maken.
Set tdf = db.CreateTableDef(SourceTableName & "_" & TargetTableName &
"_MAP")
Set fld1 = tdf.CreateField(strSourcePkeyName, dbLong)
Set fld2 = tdf.CreateField(TargetTableName & "ID", dbLong)
' Velden toevoegen.
tdf.Fields.Append fld1
tdf.Fields.Append fld2
' Primaire-sleutelindex maken.
Set idx = tdf.CreateIndex("PrimaireSleutel")
Set fldIndex = idx.CreateField(strSourcePkeyName, dbLong)
Set fldIndex2 = idx.CreateField(TargetTableName & "ID", dbLong)
' Indexvelden toevoegen.
idx.Fields.Append fldIndex
idx.Fields.Append fldIndex2
' Eigenschap Primary instellen.
idx.Primary = True
' Index toevoegen.
tdf.Indexes.Append idx
' TableDef-object toevoegen.
db.TableDefs.Append tdf
db.TableDefs.Refresh
'Relaties vastleggen met mapping-tabel
Dim relNieuw As Relation
Set relNieuw = db.CreateRelation("rel1", TargetTableName,
SourceTableName & "_" & TargetTableName & "_MAP", dbRelationUpdateCascade)
relNieuw.Fields.Append relNieuw.CreateField(TargetTableName & "ID")
relNieuw.Fields(TargetTableName & "ID").ForeignName =
TargetTableName & "ID"
db.Relations.Append relNieuw

Set relNieuw = db.CreateRelation("rel2", "TblPersoneel",
SourceTableName & "_" & TargetTableName & "_MAP", dbRelationUpdateCascade)
relNieuw.Fields.Append relNieuw.CreateField(strSourcePkeyName)
relNieuw.Fields(strSourcePkeyName).ForeignName = strSourcePkeyName
db.Relations.Append relNieuw

'9 Records toevoegen in MAP-tabel

Set rsDoel = db.OpenRecordset(TargetTableName, dbOpenDynaset)
Set rsMAP = db.OpenRecordset(SourceTableName & "_" & TargetTableName &
"_MAP", dbOpenTable)

For intLoop1 = 1 To intSourceRecordCount
strEnumeration(intLoop1) = strEnumeration(intLoop1) & ";"
For intLoop2 = 1 To Len(strEnumeration(intLoop1)) 'Overloop alle
letters in deze woordenlijsten
strCha = Mid$(strEnumeration(intLoop1), intLoop2, 1) 'bewaar
tijdelijk een teken
If InStr(" ,;", strCha) > 0 Then
If strTemp <> strAllowedEnumWord And Len(strTemp) > 1 Then
' onderzoek woord (=strTemp)
'geldig woord toevoegen
rsDoel.FindFirst ("[" & TargetFieldName & "] = '" &
strTemp & "'")
rsMAP.AddNew
rsMAP.Fields(0).Value = intSourceID(intLoop1)
rsMAP.Fields(1).Value = rsDoel.Fields(0).Value
rsMAP.Update
Else
End If
strTemp = "" 'toegevoegd woord wissen in tijdelijke opslag
Else
strTemp = strTemp & strCha ' geen woordscheiding dus teken
toevoegen aan woord
End If
Next intLoop2
strTemp = "" ' einde woordenlijst dus woord = null
Next intLoop1

rsDoel.Close
Set rsDoel = Nothing
rsMAP.Close
Set rsMAP = Nothing

Exit Sub

ErrHandling:

MsgBox Err.Number & " " & Err.Description

End Sub

"Melissa" <mk****@earthlink.net> wrote in message
news:in******************@newsread3.news.atl.earth link.net...

I have a frontend file named CustomerApp and backend file named CustomerData. CustomerApp is at C:\Customer Database and CustomerData is at S:\Customer
Database. Could someone help me with the code to do the following:
1. Create a new table named TblCustomerContact in CustomerData
2. Add a field named CustomerContactID (autonumber) in TblCustomerContact
3. Add a field named CustomerID (Number-Long) in TblCustomerContact
4. Add a field named CustomerContact (Text) in TblCustomerContact
5. Create a relationship (Ref Integrity, Cascade Delete) between CustomerID in TblCustomer and CustomerID in TblCustomerContact
6. Create a link to TblCustomerContact in CustomerApp

Thank you very much!

Melissa

[Bob Darlington]

Melissa,
The following code shows how to set up a table called 'tStaff".
You should be able to adapt to your requirements. Just change table and
field names.
Then, below that create the relationship as shown.

Sorry I can't give proper credit for the source of this stuff, but it was
probably some kind soul in this ng.

Function AddNewTableStaff() As Boolean
On Error GoTo ErrorPrimary
Dim db As Database, dbs As Database, td As TableDef, tdf As TableDef, idx As
Index, idxs As Indexes
Dim fld As Field, tbl As String

tbl = "tStaff"
Set db = CurrentDb()
'Front End
Set dbs = DBEngine(0).OpenDatabase(CurrentDataFile) 'Back
End
db.TableDefs.Delete tbl
dbs.TableDefs.Delete tbl
Set td = db.CreateTableDef(tbl)

Set fld = td.CreateField("StaffID", dbLong)
fld.Attributes = fld.Attributes + dbAutoIncrField
td.Fields.Append fld

Set fld = td.CreateField("StaffPosition", dbText, 40)
td.Fields.Append fld

Set fld = td.CreateField("StaffProperty", dbByte)
td.Fields.Append fld

Set fld = td.CreateField("StaffName", dbText, 30)
td.Fields.Append fld

Set fld = td.CreateField("StaffDateStart", dbDate)
td.Fields.Append fld

With dbs.TableDefs
.Append td
.Refresh
End With

Set tdf = db.CreateTableDef(tbl)

With tdf
.Connect = ";DATABASE=" & CurrentDataFile
.SourceTableName = tbl
End With

db.TableDefs.Append tdf

Application.RefreshDatabaseWindow

Set td = Nothing
Set db = Nothing

Exit Function
ErrorPrimary:
If Err = 3265 Then Resume Next Else MsgBox Error$ & Err
Exit Function
End Function
To create the relationship:

Function CreateRelationship(tbl As String, fgnTbl As String, fldName As
String, _
fgnFldName As String, vCC As Byte, Optional RelName As
Variant) As Boolean
On Error GoTo ErrorCreateRelationship

Dim db As Database, rel As Relation, fld As Field, strRelname As String
Set db = OpenDatabase(CurrentDataFile)
Set rel = db.CreateRelation()
'Define RelName if the Foreign field is used in more than one
relationship
If Not IsMissing(RelName) Then strRelname = RelName Else strRelname
= fgnFldName
With rel
.Name = strRelname 'tbl & fgnTbl
.Table = tbl
.ForeignTable = fgnTbl
Select Case vCC
Case 1: .Attributes = dbRelationUpdateCascade
Case 2: .Attributes = dbRelationDeleteCascade
Case 3: .Attributes = dbRelationUpdateCascade Or
dbRelationDeleteCascade
End Select
End With
Set fld = rel.CreateField(fldName)
fld.ForeignName = fgnFldName
rel.Fields.Append fld
db.Relations.Append rel
CreateRelationship = True

CloseFunction:
Set db = Nothing
Exit Function

ErrorCreateRelationship:
If Err = 3012 Then 'Already exists
db.Relations.Delete rel.Name
Resume
Else
MsgBox Error$ & Err
CreateRelationship = False
Resume CloseFunction
End If
End Function
Hope this helps
--
Bob Darlington
Brisbane
"Melissa" <mk****@earthlink.net> wrote in message
news:in******************@newsread3.news.atl.earth link.net...

I have a frontend file named CustomerApp and backend file named CustomerData. CustomerApp is at C:\Customer Database and CustomerData is at S:\Customer
Database. Could someone help me with the code to do the following:
1. Create a new table named TblCustomerContact in CustomerData
2. Add a field named CustomerContactID (autonumber) in TblCustomerContact
3. Add a field named CustomerID (Number-Long) in TblCustomerContact
4. Add a field named CustomerContact (Text) in TblCustomerContact
5. Create a relationship (Ref Integrity, Cascade Delete) between CustomerID in TblCustomer and CustomerID in TblCustomerContact
6. Create a link to TblCustomerContact in CustomerApp

Thank you very much!

Melissa

[Melissa]

Filip,

Thank you very much for your time to provide this code!

Melissa
"Filips Benoit" <be***********@pandora.be> wrote in message
news:NA**********************@phobos.telenet-ops.be...

This code is part of a utility to convert a Enumeration to a mapping. It
creates tables, fields, relations and transfer the data. This can help you
for your code!

Filip
Private Sub Enumeration2MAP(ByVal SourceTableName As String, _
ByVal SourceFieldName As String, _
ByVal TargetTableName As String, _
ByVal TargetFieldName As String, _
Optional ByVal strAllowedEnumWord As String =
"en", _
Optional ByVal DeleteSourceField As Boolean =
False)

'By Filips Benoit (be***********@pandora.be)

'These subroutine gets words from the field 'SourceFieldName' in table
'SourceTableName'
'Allowed delimiters: " " or "," or ";"
'Allowed enumeration-word: set word in variable 'strAllowedEnumWord'

'Saves the unique words in the field 'TargetFieldName' of table
'SourceTableName'
'Creates Mappingtable = 'Tbl_' & SourceTableName & "_" & SourceTableName &
"_MAP"
'Restores data by mapping Source and target according original data in
sourcefield.

On Error GoTo ErrHandling

'Declareren van variabelen
Dim intLoop1, intLoop2, intSourceRecordCount As Integer
Dim strCha, strTemp, strSourcePkeyName As String
Dim strEnumeration() As String
Dim intSourceID() As Long
Dim db As Database
Dim rsBron As Recordset
Dim rsTemp As Recordset
Dim rsMAP As Recordset
Dim rsDoel As Recordset
Dim tdf As TableDef
Dim fld, fld1, fld2, fldIndex, fldIndex2 As Field
Dim idx As Index

'1 Opslaan van Bronwaarden in array strEnumeration() en corresponderende PK
nl veld(0) in array intSourceID()
Set db = CurrentDb
Set rsBron = db.OpenRecordset(SourceTableName, dbOpenTable)
intSourceRecordCount = rsBron.RecordCount
ReDim strEnumeration(intSourceRecordCount)
ReDim intSourceID(intSourceRecordCount)
rsBron.MoveFirst
strSourcePkeyName = rsBron.Fields(0).Name
'Alle records van bron doorlopen en woordenlijsten opslaan
For intLoop1 = 1 To intSourceRecordCount
intSourceID(intLoop1) = rsBron.Fields(0).Value
strEnumeration(intLoop1) =
Trim(rsBron.Fields(SourceFieldName).Value)
rsBron.MoveNext
Next
'Bron sluiten
rsBron.Close
Set rsBron = Nothing

'2 Veld verwijderen uit brontabel
If DeleteSourceField Then
Set tdf = db.TableDefs(SourceTableName)
Set fld = tdf.Fields(SourceFieldName)
tdf.Fields.Delete fld.Name
tdf.Fields.Refresh
End If

'3 Maak Tijdelijke tabel met 2 velden
' Nieuwe tabel met twee velden maken.
Set tdf = db.CreateTableDef("TblTemp")
Set fld1 = tdf.CreateField("TempID", dbLong)
fld1.Attributes = fld1.Attributes + dbAutoIncrField
Set fld2 = tdf.CreateField("TempField2", dbText, 50)
' Velden toevoegen.
tdf.Fields.Append fld1
tdf.Fields.Append fld2
' Primaire-sleutelindex maken.
Set idx = tdf.CreateIndex("PrimaireSleutel")
Set fldIndex = idx.CreateField("TempID", dbLong)
' Indexvelden toevoegen.
idx.Fields.Append fldIndex
' Eigenschap Primary instellen.
idx.Primary = True
' Index toevoegen.
tdf.Indexes.Append idx
' TableDef-object toevoegen.
db.TableDefs.Append tdf
db.TableDefs.Refresh

'24 Woordenlijsten onderzoeken en geldige woorden opslaan in doel
Set rsTemp = db.OpenRecordset("TblTemp", dbOpenTable)

For intLoop1 = 1 To intSourceRecordCount 'Overloop alle woordenlijsten
For intLoop2 = 1 To Len(strEnumeration(intLoop1)) 'Overloop alle letters
in deze woordenlijsten
strCha = Mid$(strEnumeration(intLoop1), intLoop2, 1) 'bewaar
tijdelijk een teken
If InStr(" ,;", strCha) > 0 Then
If strTemp <> strAllowedEnumWord And Len(strTemp) > 1 Then '
onderzoek woord (=strTemp)
'geldig woord toevoegen
rsTemp.AddNew
rsTemp.Fields("TempField2").Value = strTemp
rsTemp.Update
Else
End If
strTemp = "" 'toegevoegd woord wissen in tijdelijke opslag
Else
strTemp = strTemp & strCha ' geen woordscheiding dus teken
toevoegen aan woord
End If
Next intLoop2
'einde woordenlijst zonder woordscheiding dus woord opslaan
rsTemp.AddNew
rsTemp.Fields("TempField2").Value = strTemp
rsTemp.Update
strTemp = "" ' einde woordenlijst dus woord = null
Next intLoop1
'Doel sluiten
rsTemp.Close
Set rsTemp = Nothing

'5 Maak Doeltabel tabel met 2 velden
' Nieuwe tabel met twee velden maken.
Set tdf = db.CreateTableDef(TargetTableName)
Set fld1 = tdf.CreateField(TargetTableName & "ID", dbLong)
fld1.Attributes = fld1.Attributes + dbAutoIncrField
Set fld2 = tdf.CreateField(TargetFieldName, dbText, 50)
' Velden toevoegen.
tdf.Fields.Append fld1
tdf.Fields.Append fld2
' Primaire-sleutelindex maken.
Set idx = tdf.CreateIndex("PrimaireSleutel")
Set fldIndex = idx.CreateField(TargetTableName & "ID", dbLong)
' Indexvelden toevoegen.
idx.Fields.Append fldIndex
' Eigenschap Primary instellen.
idx.Primary = True
' Index toevoegen.
tdf.Indexes.Append idx
' TableDef-object toevoegen.
db.TableDefs.Append tdf
db.TableDefs.Refresh

'6 Unieke waarden van TblTemp doorgeven naar Doeltabel
DoCmd.RunSQL ("INSERT INTO " & TargetTableName & " ( " & TargetFieldName
& " ) SELECT DISTINCT TblTemp.TempField2 FROM TblTemp;")

'7 Tijdelijke tabel wissen
db.TableDefs.Delete "TblTemp"

'8 Maak MAP-tabel met 2 velden
' Nieuwe tabel met twee velden maken.
Set tdf = db.CreateTableDef(SourceTableName & "_" & TargetTableName &
"_MAP")
Set fld1 = tdf.CreateField(strSourcePkeyName, dbLong)
Set fld2 = tdf.CreateField(TargetTableName & "ID", dbLong)
' Velden toevoegen.
tdf.Fields.Append fld1
tdf.Fields.Append fld2
' Primaire-sleutelindex maken.
Set idx = tdf.CreateIndex("PrimaireSleutel")
Set fldIndex = idx.CreateField(strSourcePkeyName, dbLong)
Set fldIndex2 = idx.CreateField(TargetTableName & "ID", dbLong)
' Indexvelden toevoegen.
idx.Fields.Append fldIndex
idx.Fields.Append fldIndex2
' Eigenschap Primary instellen.
idx.Primary = True
' Index toevoegen.
tdf.Indexes.Append idx
' TableDef-object toevoegen.
db.TableDefs.Append tdf
db.TableDefs.Refresh
'Relaties vastleggen met mapping-tabel
Dim relNieuw As Relation
Set relNieuw = db.CreateRelation("rel1", TargetTableName,
SourceTableName & "_" & TargetTableName & "_MAP", dbRelationUpdateCascade)
relNieuw.Fields.Append relNieuw.CreateField(TargetTableName & "ID")
relNieuw.Fields(TargetTableName & "ID").ForeignName =
TargetTableName & "ID"
db.Relations.Append relNieuw

Set relNieuw = db.CreateRelation("rel2", "TblPersoneel",
SourceTableName & "_" & TargetTableName & "_MAP", dbRelationUpdateCascade)
relNieuw.Fields.Append relNieuw.CreateField(strSourcePkeyName)
relNieuw.Fields(strSourcePkeyName).ForeignName = strSourcePkeyName
db.Relations.Append relNieuw

'9 Records toevoegen in MAP-tabel

Set rsDoel = db.OpenRecordset(TargetTableName, dbOpenDynaset)
Set rsMAP = db.OpenRecordset(SourceTableName & "_" & TargetTableName &
"_MAP", dbOpenTable)

For intLoop1 = 1 To intSourceRecordCount
strEnumeration(intLoop1) = strEnumeration(intLoop1) & ";"
For intLoop2 = 1 To Len(strEnumeration(intLoop1)) 'Overloop alle
letters in deze woordenlijsten
strCha = Mid$(strEnumeration(intLoop1), intLoop2, 1) 'bewaar
tijdelijk een teken
If InStr(" ,;", strCha) > 0 Then
If strTemp <> strAllowedEnumWord And Len(strTemp) > 1 Then
' onderzoek woord (=strTemp)
'geldig woord toevoegen
rsDoel.FindFirst ("[" & TargetFieldName & "] = '" &
strTemp & "'")
rsMAP.AddNew
rsMAP.Fields(0).Value = intSourceID(intLoop1)
rsMAP.Fields(1).Value = rsDoel.Fields(0).Value
rsMAP.Update
Else
End If
strTemp = "" 'toegevoegd woord wissen in tijdelijke opslag
Else
strTemp = strTemp & strCha ' geen woordscheiding dus teken
toevoegen aan woord
End If
Next intLoop2
strTemp = "" ' einde woordenlijst dus woord = null
Next intLoop1

rsDoel.Close
Set rsDoel = Nothing
rsMAP.Close
Set rsMAP = Nothing

Exit Sub

ErrHandling:

MsgBox Err.Number & " " & Err.Description

End Sub

"Melissa" <mk****@earthlink.net> wrote in message
news:in******************@newsread3.news.atl.earth link.net...

I have a frontend file named CustomerApp and backend file named

CustomerData.

CustomerApp is at C:\Customer Database and CustomerData is at S:\Customer
Database. Could someone help me with the code to do the following:
1. Create a new table named TblCustomerContact in CustomerData
2. Add a field named CustomerContactID (autonumber) in TblCustomerContact
3. Add a field named CustomerID (Number-Long) in TblCustomerContact
4. Add a field named CustomerContact (Text) in TblCustomerContact
5. Create a relationship (Ref Integrity, Cascade Delete) between

CustomerID in

TblCustomer and CustomerID in TblCustomerContact
6. Create a link to TblCustomerContact in CustomerApp

Thank you very much!

Melissa

[Melissa]

Bob,

With what you and Filip provided, it looks like I have everything I need. Thank
you very much!

Melissa
"Bob Darlington" <bo*@dpcmanAX.com.au> wrote in message
news:40***********************@news.optusnet.com.a u...

Melissa,
The following code shows how to set up a table called 'tStaff".
You should be able to adapt to your requirements. Just change table and
field names.
Then, below that create the relationship as shown.

Sorry I can't give proper credit for the source of this stuff, but it was
probably some kind soul in this ng.

Function AddNewTableStaff() As Boolean
On Error GoTo ErrorPrimary
Dim db As Database, dbs As Database, td As TableDef, tdf As TableDef, idx As
Index, idxs As Indexes
Dim fld As Field, tbl As String

tbl = "tStaff"
Set db = CurrentDb()
'Front End
Set dbs = DBEngine(0).OpenDatabase(CurrentDataFile) 'Back
End
db.TableDefs.Delete tbl
dbs.TableDefs.Delete tbl
Set td = db.CreateTableDef(tbl)

Set fld = td.CreateField("StaffID", dbLong)
fld.Attributes = fld.Attributes + dbAutoIncrField
td.Fields.Append fld

Set fld = td.CreateField("StaffPosition", dbText, 40)
td.Fields.Append fld

Set fld = td.CreateField("StaffProperty", dbByte)
td.Fields.Append fld

Set fld = td.CreateField("StaffName", dbText, 30)
td.Fields.Append fld

Set fld = td.CreateField("StaffDateStart", dbDate)
td.Fields.Append fld

With dbs.TableDefs
.Append td
.Refresh
End With

Set tdf = db.CreateTableDef(tbl)

With tdf
.Connect = ";DATABASE=" & CurrentDataFile
.SourceTableName = tbl
End With

db.TableDefs.Append tdf

Application.RefreshDatabaseWindow

Set td = Nothing
Set db = Nothing

Exit Function
ErrorPrimary:
If Err = 3265 Then Resume Next Else MsgBox Error$ & Err
Exit Function
End Function
To create the relationship:

Function CreateRelationship(tbl As String, fgnTbl As String, fldName As
String, _
fgnFldName As String, vCC As Byte, Optional RelName As
Variant) As Boolean
On Error GoTo ErrorCreateRelationship

Dim db As Database, rel As Relation, fld As Field, strRelname As String
Set db = OpenDatabase(CurrentDataFile)
Set rel = db.CreateRelation()
'Define RelName if the Foreign field is used in more than one
relationship
If Not IsMissing(RelName) Then strRelname = RelName Else strRelname
= fgnFldName
With rel
.Name = strRelname 'tbl & fgnTbl
.Table = tbl
.ForeignTable = fgnTbl
Select Case vCC
Case 1: .Attributes = dbRelationUpdateCascade
Case 2: .Attributes = dbRelationDeleteCascade
Case 3: .Attributes = dbRelationUpdateCascade Or
dbRelationDeleteCascade
End Select
End With
Set fld = rel.CreateField(fldName)
fld.ForeignName = fgnFldName
rel.Fields.Append fld
db.Relations.Append rel
CreateRelationship = True

CloseFunction:
Set db = Nothing
Exit Function

ErrorCreateRelationship:
If Err = 3012 Then 'Already exists
db.Relations.Delete rel.Name
Resume
Else
MsgBox Error$ & Err
CreateRelationship = False
Resume CloseFunction
End If
End Function
Hope this helps
--
Bob Darlington
Brisbane
"Melissa" <mk****@earthlink.net> wrote in message
news:in******************@newsread3.news.atl.earth link.net...

I have a frontend file named CustomerApp and backend file named

CustomerData.

CustomerApp is at C:\Customer Database and CustomerData is at S:\Customer
Database. Could someone help me with the code to do the following:
1. Create a new table named TblCustomerContact in CustomerData
2. Add a field named CustomerContactID (autonumber) in TblCustomerContact
3. Add a field named CustomerID (Number-Long) in TblCustomerContact
4. Add a field named CustomerContact (Text) in TblCustomerContact
5. Create a relationship (Ref Integrity, Cascade Delete) between

CustomerID in

TblCustomer and CustomerID in TblCustomerContact
6. Create a link to TblCustomerContact in CustomerApp

Thank you very much!

Melissa