#59
「アップサイジングウィザード」に代わるプログラムの４回目です。
テーブルのSQL Serverへの移行ができたので、それに関連してAccess側のリレーションシップをSQL Serverへも適用してみます。
リレーションシップ情報の取得
まずAccessのデータベース上で設定されているリレーションシップの情報収集を行います。それには次のようなプログラムを使います。
カレントデータベースのリレーションシップ全体である「Relations」コレクションをループで辿り、そこから１つずつ「Relation」オブジェクトを取り出していきます。
Sub TrySample_4_1()
Dim dbs As Database
Dim rel As Relation
Set dbs = CurrentDb
For Each rel In dbs.Relations
If Not (rel.Attributes And dbRelationInherited) And _
(Left$(rel.Table, 4) <> "MSys" And Left$(rel.ForeignTable, 4) <> "MSys") Then
'リンクテーブルとシステムテーブルのリレーションシップは除外
With rel
Debug.Print .Name 'リレーションシップ名
Debug.Print .Table '主側テーブル名
Debug.Print .ForeignTable '外部テーブル名
Debug.Print .Fields(0).Name '主側結合フィールド名
Debug.Print .Fields(0).ForeignName '外部結合フィールド名
Debug.Print (.Attributes And dbRelationUpdateCascade) > 0 '連鎖更新
Debug.Print (.Attributes And dbRelationDeleteCascade) > 0 '連鎖削除
End With
End If
Next rel
End Sub
１つのRelationオブジェクトがリレーションシップの画面における結合線１つを表しています。よってそのオブジェクトの所定のプロパティを参照することで、リレーションシップの結合の内容を調べることができます。
ここでは、次のステップでのSQL ServerへのSQL文の発行に必要となる６つのプロパティを参照し、イミディエイトウィンドウに出力しています。
- リレーションシップのSQL文の生成と発行
Access側のリレーションシップの情報を収集したら、その１つ１つについて、「ALTER TABLE」のSQL文を組み立ててSQL Serverへ発行します。
その際のSQLの構文は次のようなものです。それぞれについて上記でコードで取得したプロパティ値を当てはめていきます。
ALTER TABLE テーブル名
ADD CONSTRAINT リレーションシップ名
FOREIGN KEY (フィールド名)
REFERENCES 参照先テーブル名 (参照先フィールド名)
ON UPDATE CASCADE
ON DELETE CASCADE
- 「ON UPDATE CASCADE」は「連鎖更新」を設定することを表します。
- 「ON DELETE CASCADE」は「連鎖削除」を設定することを表します。
実際にその一連の処理を行うプログラムが次のコードになります。
- リレーションシップ名は一意であればかまいませんので、Access側のプロパティ値をそのまま使えます。ただし今回のプログラムでは「FK_テーブル名_参照先テーブル名」という構成の名前を付けるものとしました。
- Access側のRelationオブジェクトを調べると、２つのテーブルが「１対多」の関係にあるとき、１側が”主側テーブル”、多側が”外部テーブル”として取得されます。そのまま主側を”テーブル名”、多側を”参照先テーブル”とするSQL文ではエラーとなりリレーションシップが生成されませんでした。そこで下記プログラムでは１側を”外部テーブル”のプロパティ値、多側を”主側テーブル”のプロパティ値に置き換えて実行しています。
- このプロシージャではローカルのAccessデータベースとSQL Server上のデータベースの２つのDatabaseオブジェクトを扱っています。それぞれ「Dim dbsServer」、「dbsLocal」という２つの変数で使い分けています。
Sub TrySample_4_2()
Dim dbsServer As Database
Dim dbsLocal As Database
Dim strConStr As String
Dim rel As Relation
Dim strSQL As String
strConStr = "ODBC;DRIVER=SQL Server;" & _
"SERVER=NAFUREI;" & _
"DATABASE=UpSizeTest;" & _
"Trusted_Connection=Yes;"
On Error GoTo Err_Handler
'SQL Server上のUpSizeTestデータベースに接続
Set dbsServer = OpenDatabase("", False, False, strConStr)
Set dbsLocal = CurrentDb
For Each rel In dbsLocal.Relations
With rel
'リンクテーブルとシステムテーブルのリレーションシップは除外
If Not (.Attributes And dbRelationInherited) And _
(Left$(.Table, 4) <> "MSys" And Left$(.ForeignTable, 4) <> "MSys") Then
'RelationオブジェクトのプロパティからSQL文を組み立て
strSQL = "ALTER TABLE " & .ForeignTable & " " & _
"ADD CONSTRAINT " & "FK_" & .ForeignTable & "_" & .Table & " " & _
"FOREIGN KEY (" & .Fields(0).ForeignName & ") " & _
"REFERENCES " & .Table & " (" & .Fields(0).Name & ") "
If (.Attributes And dbRelationUpdateCascade) > 0 Then
strSQL = strSQL & "ON UPDATE CASCADE "
End If
If (.Attributes And dbRelationDeleteCascade) > 0 Then
strSQL = strSQL & "ON DELETE CASCADE "
End If
'SQL文をSQL Serverに発行
dbsServer.Execute strSQL, dbSQLPassThrough
End If
End With
Next rel
Exit_Here:
Exit Sub
Err_Handler:
MsgBox "エラー番号：" & Err.Number & vbCrLf & vbCrLf & _
"エラー内容：" & Err.Description, vbOKOnly + vbCritical
Resume Exit_Here:
End Sub
- 「ON UPDATE CASCADE」は「連鎖更新」を設定することを表します。
