在 MS Access VBA 中創建外鍵

Question

我有表 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

當我運行上面的子程序時，出現錯誤：“索引或關系定義中的無效字段定義“代碼”

更新：這個問題的不同之處在於我遇到的問題的一部分是，當我改變表時，我需要在兩個表中都有相同的字段。

Answer 1

您的初始 SQL 語句在字段“Ticker”上創建一個名為“TickerID”的索引。 這就是調試語句返回“Ticker”而不是“TickerID”的原因。

您的外鍵 SQL 應該是：

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

這假設您在 tbl1 中有一個名為“Ticker”的字段，該字段與 tbl0.Ticker 的類型相同。

其中的第二行表示您正在創建的外鍵字段引用了另一個表中的相關鍵字段。 像這樣閱讀：我正在更改的表 (tbl1) 中的外鍵“Ticker”引用了相關表“tbl0”中的主鍵“Ticker”。

我使用這個例程，你可能會發現它很有幫助。 它確實做了一些假設：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

參考：

• 約束子句（Microsoft Access SQL）
• INDEX 子句（Microsoft Access SQL）

Answer 2

我認為你的 sql 應該是這樣的：

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

parentId 是tickerID，child 是ticker。

Answer 3

也許舊但我發現這種語法有效您想在 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