在MS Access VBA中创建外键

时间:2015-07-07 19:22:41

标签: sql vba ms-access access-vba ms-access-2013

我有表tbl0和表tbl1。 tbl0有一个主键,由字段" Ticker"我创建的是这样的:

Sub CreatPrimaryKey()
Dim db As Database
Set db = CurrentDb
db.Execute "CREATE INDEX TickerID ON tbl0 (Ticker) WITH PRIMARY;"
db.Close
End Sub

......工作正常。

我通过使用以下方式确认我有主键:

Sub GetPrimaryKeyField()
Call PrimKey("tbl0")
End Sub

Public Sub PrimKey(tblName As String)
'get primary key of tabel
'how to use: Call PrimKey("tbl_DatedModel_2015_0702_0")
'http://bytes.com/topic/access/answers/679509-finding-primary-key-using-vba
'*******************************************
'Purpose: Programatically determine a
' table's primary key
'Coded by: raskew
'Inputs: from Northwind's debug window:
' Call PrimKey("Products")
'Output: "ProductID"
'*******************************************

Dim db As Database
Dim td As TableDef
Dim idxLoop As Index

Set db = CurrentDb
Set td = db.TableDefs(tblName)
For Each idxLoop In td.Indexes
If idxLoop.Primary = True Then
Debug.Print Mid(idxLoop.Fields, 2)
Exit For
End If
Next idxLoop

db.Close
Set db = Nothing
End Sub

即时窗口打印" Ticker"。我不确定" TickerID"发生了什么,但无论如何。我得到了PK。然后,我尝试通过执行以下操作在tbl0和tbl1之间创建外键关系:

Sub CreateForeignKey()Dim db As Database
Set db = CurrentDb

db.Execute "ALTER TABLE tbl1 " _
        & "ADD CONSTRAINT fk_tbl1_tbl0 " _
        & "FOREIGN KEY (Ticker) REFERENCES tbl0 (Ticker);"

    db.Close
End Sub

当我运行上面的子时,我得到错误: "字段定义无效" Ticker"在索引或关系的定义中#34;

更新:这个问题的不同之处在于我遇到的问题的一部分是我在AlTER TABLE时需要在两个表中都有相同的字段。

3 个答案:

答案 0 :(得分:1)

您的初始SQL语句创建一个名为" TickerID"的索引。在球场" Ticker。"这就是调试语句返回" Ticker"而不是" TickerID。"

您的外键SQL应该是:

ALTER TABLE tbl1 ADD CONSTRAINT fk_tbl1_tbl0 
FOREIGN KEY (Ticker) REFERENCES tbl0 (Ticker);

这假设你在tbl1中有一个名为" Ticker"的字段。这与tbl0.Ticker的类型相同。

此处的第二行表示您正在创建的外键字段引用另一个表中的相关键字段。读它是这样的:外键" Ticker"在表中,我正在改变(tbl1)引用主键" Ticker"在相关表格中" tbl0"。

我使用这个例程,你可能会觉得有帮助。它确实做了一些假设:1)主键始终命名为{table_name} +" Id" 2)外键通常被命名为同一个东西。 (这些都是常见做法,在我看来是可取的)。

Public Function CreateForeignKey( _
        db As DAO.Database, _
        ByVal sTable As String, _
        ByVal sPrimaryTable As String, _
        Optional ByVal sField As String) As Boolean

    Dim sSQL As String
    Dim sSuffix As String

    On Error GoTo EH

    If sField = "" Then
        sField = sPrimaryTable & "Id"
    Else
        sSuffix = "_" & sField
    End If

    sSQL = "ALTER TABLE [" & sTable & "]" _
        & " ADD CONSTRAINT FK_" & sTable & "_" & sPrimaryTable & sSuffix _
        & " FOREIGN KEY([" & sField & "])" _
        & " REFERENCES [" & sPrimaryTable & "] ([" & sPrimaryTable & "Id]);"

    db.Execute sSQL, dbFailOnError

    CreateForeignKey = True

    Exit Function
EH:

    MsgBox "Error " & Err.Number & vbCrLf _
        & " (" & Err.Source & vbCrLf _
        & " (" & Err.Description _
        & ") in procedure CreateForeignKey of Module Database"

End Function

参考文献:

答案 1 :(得分:0)

我认为你的sql应该是这样的:

 ALTER TABLE tbl1 ADD CONSTRAINT fk_tbl1_tbl0 
FOREIGN KEY (TickerId) REFERENCES tbl0 (Ticker);

parentId是tickerID,孩子是自动收报机。

答案 2 :(得分:0)

也许老了,但是我发现这种语法可以工作 您想在PK之前指定FK,尽管我不记得为什么在PK中包含FK的合理做法。

Sub CreateTableJours()
On Error Resume Next
    Application.CurrentDb.Execute "Drop Table [Jours];"
'---------------'---------------'
On Error GoTo onError
    Dim con As ADODB.Connection
    Set con = CurrentProject.Connection
    con.Execute "" _
    & "CREATE TABLE [Jours](" _
    & " [jcode]             COUNTER" _
    & ",[jdate]             DATETIME" _
    & ",[tid]               INTEGER" _
    & ",[cid]               INTEGER" _
    & ",[jdepense]          MONEY" _
    & ",[jjustificatif]     CHAR" _
    & ",CONSTRAINT [FK_Taches] FOREIGN KEY ([tid]) REFERENCES Personnes" _
    & ",CONSTRAINT [FK_Chantiers] FOREIGN KEY ([cid]) REFERENCES Chantiers" _
    & ",CONSTRAINT [PK_Jours] PRIMARY KEY ([jcode])" _
    & ");"
    Set con = Nothing
Exit Sub
'---------------'---------------'
onFail:
    myErrorLvl = 250
    Set con = Nothing
Exit Sub
'---------------'---------------'
onError:
    MsgBox Err.Description, , "Erreur(" & myErrorLvl & ") in " & "INIT.CreateTableJours" & "#" & Err.Number
    If myErrorLvl < 1 Then Resume onFail
End Sub