| MSDE FunClub |
|
最終更新日 : 2000/11/03 |
|
Microsoft Data Engine FunClub
|
Since 2000.11.03
|
|
SQLServer7.0/MSDE 完全トレーニングテキスト（下巻） |
|
【第２２章４３６ｐ 〜 ４４７ｐ掲載】 |
Option Compare Database
Option Explicit
'
'************************************************************
'
' Access97対応のテーブルに設定された列制約・テーブル制約を調査します
' その結果をストアドプロシージャ呼び出しに作成します
'
' このプログラムは、Access97上で開発しました
'
' このプログラムを、Accessのモジュールシートに読み込んで実行します
'
' （株）日本技術ソフト開発 堀川 明
' http://www.horikawa.ne.jp/msde/
'
'************************************************************
'
'書き込み先テキストファイル名
Const Fname = "D:\Modify.SQL"
'ファイル番号
Dim FNO%
'主キーの列数を記憶
Dim PK_COL%
'主キーの列名を記憶する
Dim PK_NM$(10)
'
Function MKCONSTRAINT()
Dim m%, i%, tbnm$
'ファイルオープン
FNO = FreeFile
Open Fname For Output As #FNO
'テーブル個数（但しアクセスのシステムテーブルを含む）
m = CurrentDb.TableDefs.Count
'TableDefsの添字は 0 から
For i = 0 To m - 1
'テーブルの名前を取得
tbnm$ = CurrentDb.TableDefs(i).Name
'アクセスのシステムテーブルを除く
If Left(tbnm$, 4) <> "MSys" Then
'制約を作成しますか？
If MsgBox(tbnm$ & vbCrLf & "このテーブルの制約を作成しますか？", _
vbYesNo, "制約の作成を行ないますか？") = vbYes Then
'制約の作成
Prt ""
Prt "-- *********************************************"
Prt "-- 【" + tbnm$ & "】テーブルに制約を設定する"
Prt "-- *********************************************"
MakeCONSTRAINT tbnm$
Prt "GO"
End If
End If
Next
'テーブル間の参照整合性の定義を行う
MakeRelation
Close #FNO
MsgBox "制約作成が終了しました", , "終了"
End Function
'
'***********************************************
' テーブルに付けられている制約を調査します
'***********************************************
'
Sub MakeCONSTRAINT(tblnm$)
'主キーの設定"
Search_PrimaryKey tblnm$
'値要求［はい］の設定（NOT NULL）"
Search_NotNull tblnm$
'空文字列の許可［いいえ］の設定（空文字列入力を拒否する）
Search_NotZeroChar tblnm$
'CHECK制約の設定（Accessの式をSQLServerに直してください）
Search_CheckConst tblnm$
'DEFAULT制約の設定（Accessの式をSQLServerに直してください）
Search_DefaultConst tblnm$
'インデックスの設定
Search_Index tblnm$
End Sub
'
'***********************************************
' 主キーの調査を行なう
'***********************************************
'
Sub Search_PrimaryKey(tblnm$)
Dim idx As Index
Dim fd As Field
Dim cn$, i%, sqltp$, header
Dim dbs As Database
Dim tbl As TableDef
header = True
Set dbs = CurrentDb
Set tbl = dbs.TableDefs(tblnm$)
'主キーを構成する列数
PK_COL = 0
'主キー属性のあるインデックスオブジェクトを探す
For Each idx In tbl.Indexes
'主キー属性です
If idx.Primary Then
i = 0
'主キー属性を構成する列は、NOT NULL 属性です
For Each fd In idx.Fields
If header Then
Prt " --主キーの設定"
header = False
End If
'列の名前
PK_NM(i) = fd.Name
'Accessのデータ型をSQLServer型に変換する
AccessTypeToSQL tbl.Fields(PK_NM(i)).Type, tbl.Fields(PK_NM(i)).Size, sqltp$
'主キーを構成する列に NOT NULL 属性を設定
Prt " EXEC ALTTBL_NotNULL '" & tblnm$ & "' , '" & PK_NM(i) & _
"' , '" & sqltp$ & "'"
i = i + 1
Next
'ここでバッチを区切る
'［受注明細］表のとき、ここで区切らないとエラーが発生した
Prt "GO"
PK_COL = i
'主キーは単独ですか？
If i = 1 Then
Prt " EXEC ALTTBL_SetPrimaryKey '" & tblnm$ & _
"' , '" & PK_NM$(0) & "'"
'連結主キーの設定
Else
'制約削除
cn$ = "PK_" & tblnm$ '制約名
Prt " ALTER TABLE " & tblnm$ & " DROP CONSTRAINT " & cn$
'制約の設定
If i = 2 Then
Prt " ALTER TABLE " & tblnm$ & " ADD CONSTRAINT " & cn$ & _
" PRIMARY KEY " & "( " & PK_NM(0) & "," & PK_NM(1) & ")"
ElseIf i = 3 Then
Prt " ALTER TABLE " & tblnm$ & " ADD CONSTRAINT " & cn$ & _
" PRIMARY KEY " & "( " & PK_NM(0) & "," & PK_NM(1) & "," & PK_NM(2) & ")"
ElseIf i = 4 Then
Prt " ALTER TABLE " & tblnm$ & " ADD CONSTRAINT " & cn$ & _
" PRIMARY KEY " & _
"( " & PK_NM(0) & "," & PK_NM(1) & "," & PK_NM(2) & "," & PK_NM(3) & ")"
Else
Prt " 連結に関係する列が５個以上は、設計を見なおした方がいいです"
End If
End If
End If
Next
If Not header Then Prt ""
End Sub
'
'***********************************************
' 値要求［はい］の調査を行なう
'***********************************************
'
Sub Search_NotNull(tblnm$)
Dim colnm$, sqltp$, i%, PFlag, header
Dim dbs As Database
Dim tbl As TableDef
Dim fd As Field
header = True
Set dbs = CurrentDb
Set tbl = dbs.TableDefs(tblnm$)
'テーブルのフィールドを１個１個調査します
For Each fd In tbl.Fields
'フィールドの名前を取得する
colnm$ = fd.Name
'この名前は主キーを構成する列ですか？
PFlag = True
For i = 0 To PK_COL - 1
If colnm$ = PK_NM(i) Then PFlag = False
Next
'値要求が［はい］ですか？
If PFlag And fd.Required Then
If header Then
Prt " --値要求［はい］の設定（NOT NULL）"
header = False
End If
'Accessのデータ型をSQLServer型に変換する
AccessTypeToSQL fd.Type, fd.Size, sqltp$
'ストアドプロシージャの呼び出し文の作成
Prt " EXEC ALTTBL_NotNULL '" & tblnm$ & "' , '" & colnm$ & _
"' , '" & sqltp$ & "'"
End If
Next
If Not header Then Prt ""
End Sub
'
'****************************************************
' 空文字列の許可［いいえ］の設定（空文字列入力を拒否）
'****************************************************
'
Sub Search_NotZeroChar(tblnm$)
Dim colnm$, header
Dim dbs As Database
Dim tbl As TableDef
Dim fd As Field
header = True
Set dbs = CurrentDb
Set tbl = dbs.TableDefs(tblnm$)
'テーブルのフィールドを１個１個調査します
For Each fd In tbl.Fields
'フィールドの名前を取得する
colnm$ = fd.Name
'長さ0の空文字列の入力を拒否しますか？
If (fd.Type = dbText Or fd.Type = dbMemo) And (Not fd.AllowZeroLength) Then
'Check制約は、データ型によっては、設定できない
If DoCheck(fd) Then
If header Then
Prt " --空文字列の許可［いいえ］の設定（空文字列入力を拒否する）"
header = False
End If
'ストアドプロシージャの呼び出し文の作成
Prt " EXEC ALTTBL_SetCHECK '" & tblnm$ & "' , '" & colnm$ & _
"' , '" & colnm$ & " <> '''' '"
End If
End If
Next
If Not header Then Prt ""
End Sub
'
'****************************************************
' CHECK制約式の設定
' Accessの式をSQLServer用に後で変換してください
'****************************************************
'
Sub Search_CheckConst(tblnm$)
Dim colnm$, header
Dim dbs As Database
Dim tbl As TableDef
Dim fd As Field
header = True
Set dbs = CurrentDb
Set tbl = dbs.TableDefs(tblnm$)
'テーブルのフィールドを１個１個調査します
For Each fd In tbl.Fields
'フィールドの名前を取得する
colnm$ = fd.Name
'ValidationRule プロパティを調べる
If fd.ValidationRule <> "" Then
If header Then
Prt " --CHECK制約の設定（Accessの式をSQLServerに直してください）"
header = False
End If
'ストアドプロシージャの呼び出し文の作成
Prt " EXEC ALTTBL_SetCHECK '" & tblnm$ & "' , '" & colnm$ & _
"' , '*** " & fd.ValidationRule & " ***'"
End If
Next
If Not header Then Prt ""
End Sub
'
'****************************************************
' CHECK制約を実行できますか？
' 実行できるものは TRUE を返す
' Text型の場合は、設定ができません
'****************************************************
'
Function DoCheck(fd As Field) As Boolean
Dim sqltp$
DoCheck = True
'Accessのデータ型をSQLServer型に変換する
AccessTypeToSQL fd.Type, fd.Size, sqltp$
If sqltp$ = "Text" Then
Prt "-- " & fd.Name & "列は、Text型のため、CHECK制約式の設定ができませんでした"
DoCheck = False
End If
End Function
'
'****************************************************
' DEFAULT制約式の設定
' Accessの式をSQLServer用に後で変換してください
'****************************************************
'
Sub Search_DefaultConst(tblnm$)
Dim colnm$, header
Dim dbs As Database
Dim tbl As TableDef
Dim fd As Field
header = True
Set dbs = CurrentDb
Set tbl = dbs.TableDefs(tblnm$)
'テーブルのフィールドを１個１個調査します
For Each fd In tbl.Fields
'フィールドの名前を取得する
colnm$ = fd.Name
'DefaultValue プロパティを調べる
If fd.DefaultValue <> "" Then
If header Then
Prt " --DEFAULT制約の設定（Accessの式をSQLServerに直してください）"
header = False
End If
'ストアドプロシージャの呼び出し文の作成
Prt " EXEC ALTTBL_SetDEFAULT '" & tblnm$ & "' , '" & colnm$ & _
"' , '*** " & fd.DefaultValue & " ***'"
End If
Next
If Not header Then Prt ""
End Sub
'
'***********************************************
' インデックスの調査を行なう
'***********************************************
'
Sub Search_Index(tblnm$)
Dim idx As Index
Dim fd As Field
Dim cn$, i%, sqltp$, NM$(10), header, fg%
Dim dbs As Database
Dim tbl As TableDef
header = True
Set dbs = CurrentDb
Set tbl = dbs.TableDefs(tblnm$)
'インデックスオブジェクトを探す
For Each idx In tbl.Indexes
'主キー属性と外部キー属性は除くこと
If (Not idx.Primary) And (Not idx.Foreign) Then
If header Then
Prt " --インデックスの作成（フラグ 0=重複あり 1=UNIQUE）"
header = False
End If
i = 0
'インデックスを構成する列名に取得
For Each fd In idx.Fields
'列の名前
NM(i) = fd.Name
i = i + 1
Next
'Normal or Unique?
fg% = 0
If idx.Unique Then fg% = 1
'単独ですか？
If i = 1 Then
Prt " EXEC ALTTBL_MakeIDX '" & tblnm$ & _
"' , '" & NM$(0) & "' , " & fg%
'連結主キーの設定
Else
'制約削除
cn$ = "IX_" & tblnm$ '制約名
Prt " ALTER TABLE " & tblnm$ & " DROP CONSTRAINT " & cn$
'制約の設定
If i = 2 Then
Prt " CREATE " & IIf(fg% = 0, "", "UNIQUE") & " INDEX " & cn$ & _
" ON " & tblnm$ & " ( " & NM(0) & "," & NM(1) & ")"
ElseIf i = 3 Then
Prt " CREATE " & IIf(fg% = 0, "", "UNIQUE") & " INDEX " & cn$ & _
" ON " & tblnm$ & " ( " & NM(0) & "," & NM(1) & "," & NM(2) & ")"
ElseIf i = 4 Then
Prt " CREATE " & IIf(fg% = 0, "", "UNIQUE") & " INDEX " & cn$ & _
" ON " & tblnm$ & " ( " & NM(0) & "," & NM(1) & "," & NM(2) & "," & NM(3) & ")"
Else
Prt " 連結に関係する列が５個以上は、設計を見なおした方がいいです"
End If
End If
End If
Next
If Not header Then Prt ""
End Sub
'
'***********************************************
' テーブル間の参照整合性制約を作成する
'***********************************************
'
Sub MakeRelation()
Dim total%, fm$
Dim dbs As Database
Dim rel As Relation
Set dbs = CurrentDb
'リレーションの個数
total = dbs.Relations.Count
If total = 0 Then Exit Sub
Prt ""
Prt "-- **************************************************"
Prt "-- 【参照整合性制約の設定】 "
Prt " -- ALTTBL_SetRelation 主キーTable , 主キー列名 , "
Prt " -- 外部キーTable , 外部キー列名 "
Prt "-- ***************************************************"
fm$ = "!@@@@@@@@@@@@@@@@"
For Each rel In dbs.Relations
Prt " EXEC ALTTBL_SetRelation " & _
Format$("'" + rel.Table + "'", fm$) & "," & _
Format$("'" + rel.Fields(0).Name + "'", fm$) & "," & _
Format$("'" + rel.ForeignTable + "'", fm$) & "," & _
Format$("'" + rel.Fields(0).ForeignName + "'", fm$)
Next
Prt "GO"
End Sub
'
'******************
' メッセージの出力
'******************
'
Sub Prt(msg$)
'Debug.Print msg$
Print #FNO, msg$
End Sub
'
'*************************************************************
' アクセスのデータ型宣言からSQLServerのデータ型宣言に変換します
'*************************************************************
'
Sub AccessTypeToSQL(actp%, acsz%, sqltp$)
'データ型の取得
Select Case actp%
Case dbBoolean 'ブール型 (Boolean)
sqltp$ = "Bit"
Case dbByte 'バイト型 (Byte)
sqltp$ = "Tinyint"
Case dbChar 'CHAR 型 (Char)
sqltp$ = "VARCHAR(" & acsz% & ")"
Case dbCurrency '通貨型 (Currency)
sqltp$ = "Money"
Case dbDate '日付 / 時刻型(Date / Time)
sqltp$ = "DATETIME"
Case dbDouble '倍精度浮動小数点数型 (Double)
sqltp$ = "FLOAT"
Case dbInteger '整数型 (Integer)
sqltp$ = "SMALLINT"
Case dbLong '長整数型 (Long)
sqltp$ = "INT"
Case dbLongBinary 'ロング バイナリ型 (LongBinary) - OLE オブジェクト型 (OLE Object)
sqltp$ = "IMAGE"
Case dbMemo 'メモ型(Memo)
sqltp$ = "Text"
Case dbSingle '単精度浮動小数点数型 (Single)
sqltp$ = "Real"
Case dbText 'テキスト型(Text)
sqltp$ = "VARCHAR(" & acsz% & ")"
Case dbTime '時刻型(Time)
sqltp$ = "Datetime"
Case dbTimeStamp 'タイムスタンプ型(TimeStamp)
sqltp$ = "timestamp"
Case dbVarBinary '可変長バイナリ型(VarBinary)
sqltp$ = "varbinary(" & acsz% & ")"
End Select
End Sub
