473,226 Members | 1,368 Online
Bytes | Software Development & Data Engineering Community
Post Job

Home Posts Topics Members FAQ

Join Bytes to post your question to a community of 473,226 software developers and data experts.

Create Table, Add fields, Relationship and Link

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
Nov 13 '05 #1
4 5963
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

Nov 13 '05 #2
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

Nov 13 '05 #3
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


Nov 13 '05 #4
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


Nov 13 '05 #5

This thread has been closed and replies have been disabled. Please start a new discussion.

Similar topics

5
by: Sean Byrne | last post by:
We have a Microsoft Access 2000 database consisting of 20 tables covering 20 different events. In each table, there are 3 Team members, a date of the event and several unique fields for the event,...
2
by: Detroit_Dan | last post by:
Howdy all, I am having trouble deciding on table strategies. My last dB project was 1994ish in 1-2-3... My goal is a database which will keep track of equipment in the field, and provide...
1
by: KC | last post by:
Hello, I am using Access 2002. WinXP, Template from MS called Orders Mgmt DB. I have tweaked this DB to work for our small co. It has worked pretty well up until I made the mistake of deleting...
2
by: deko | last post by:
As part of an upgrade routine, I need to delete all relations, drop and import some tables, then reapply the relationships. The error I'm getting is: Error Number 3366: Cannot append a...
2
by: Mindy | last post by:
Hey, I want to create links between my two tables. The primary keys of these two tables are character variables, with length =11. I followed exactly the instruction of Dummuy Book for ACCESS...
1
by: a.t.brooks | last post by:
I know this has been posted elsewhere, but none of the fixes in those posts seems to address the problem I have. First some background; I have two tables, Exp_info (containing the field "ExpID"...
3
ebs57
by: ebs57 | last post by:
I am looking for some basic help in understanding and setting up table relationships in Access. I've created one table called PROJECTS and it has the field JobNo which I've declared as the key...
0
by: Shootah | last post by:
Hi, I have succeeded in adding automated relationships with refference tables after importing an excel file created from a query to an Access database. However I have the following problem: ...
5
by: Yitzak | last post by:
Hi after adding a field to a table through VBA How do I create a foreign key constraint/relationship between this field and a field in another table - and enforce referential integrity through...
0
by: veera ravala | last post by:
ServiceNow is a powerful cloud-based platform that offers a wide range of services to help organizations manage their workflows, operations, and IT services more efficiently. At its core, ServiceNow...
3
isladogs
by: isladogs | last post by:
The next Access Europe meeting will be on Wednesday 3 Jan 2024 starting at 18:00 UK time (6PM UTC) and finishing at about 19:15 (7.15PM). For other local times, please check World Time Buddy In...
0
by: jianzs | last post by:
Introduction Cloud-native applications are conventionally identified as those designed and nurtured on cloud infrastructure. Such applications, rooted in cloud technologies, skillfully benefit from...
0
by: mar23 | last post by:
Here's the situation. I have a form called frmDiceInventory with subform called subfrmDice. The subform's control source is linked to a query called qryDiceInventory. I've been trying to pick up the...
0
by: abbasky | last post by:
### Vandf component communication method one: data sharing ​ Vandf components can achieve data exchange through data sharing, state sharing, events, and other methods. Vandf's data exchange method...
2
isladogs
by: isladogs | last post by:
The next Access Europe meeting will be on Wednesday 7 Feb 2024 starting at 18:00 UK time (6PM UTC) and finishing at about 19:30 (7.30PM). In this month's session, the creator of the excellent VBE...
0
by: fareedcanada | last post by:
Hello I am trying to split number on their count. suppose i have 121314151617 (12cnt) then number should be split like 12,13,14,15,16,17 and if 11314151617 (11cnt) then should be split like...
0
by: stefan129 | last post by:
Hey forum members, I'm exploring options for SSL certificates for multiple domains. Has anyone had experience with multi-domain SSL certificates? Any recommendations on reliable providers or specific...
0
by: MeoLessi9 | last post by:
I have VirtualBox installed on Windows 11 and now I would like to install Kali on a virtual machine. However, on the official website, I see two options: "Installer images" and "Virtual machines"....

By using Bytes.com and it's services, you agree to our Privacy Policy and Terms of Use.

To disable or enable advertisements and analytics tracking please visit the manage ads & tracking page.