FC2ブログ

スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

↑やる気アップにご協力をお願いします。わぁいヽ(∇⌒ヽ)(ノ⌒∇)ノわぁい♪

こんな記事もありますよ


テーブル構造の比較 パート2

以前「別のデータベースとテーブルの構造を比較しちゃう?」という
タイトルの記事の中でプロシージャを作成しましたが、

アクセス解析で見ると、ぼちぼち引っかかるみたいです。(ちょっとうれしい・・・(-。-) ボソッ)

また、自分の作成するシステムの中でも結構使えそうだったので

少し機能を拡張して、標準プロシージャで作成してみまいた。

そんなわけで今回の無駄コードは、

テーブル構造を比較しちゃいなよ・・・パート2(標準プロシージャ編)」です。



今回も別のデータベース内にあるテーブルとの構造比較ですが、
テーブル名はもちろんですが、フィールド順なども
双方同じであることをベースに作成しています。

また、前回作成したプロシージャでは、プロシージャ内でテーブルを指定しましたが、
今回は、引数内で指定するようにしています。

また、比較先のテーブルがリンクテーブルでも比較するかどうかの指定も
できるようにしてみました。

ま~相変わらずの無駄コード満載ですけれど・・・
とりあえず・・・こんな感じです。
Public Function TblCompare( _
dbPass As String, tblNames As String, PermitLink As Boolean) As Boolean

On Error GoTo errhnd 'エラートラップ用

'比較元DB(現在のDB)用の変数 B <- Base
Dim Bdb As DAO.Database
Dim Brs As DAO.Recordset

'比較先DB用の変数 C <- Compare
Dim Cdb As DAO.Database
Dim Crs As DAO.Recordset

'テーブル名格納用 配列変数
Dim ArrTbl As Variant

'ループ用変数
Dim Ti As Integer 'テーブルループ用
Dim Fi As Integer 'フィールドループ用

Dim strErr As String 'エラーメッセージ用変数

'比較先DBの存在確認
If Dir(dbPass) = "" Then
strErr = "指定されたデータベースが存在しません。"
GoTo No_Match
End If

'引数で指定したテーブル名を配列変数に格納
ArrTbl = Split(tblNames, ",")

'データベースの定義
Set Bdb = CurrentDb() '比較元DBのセット
Set Cdb = DBEngine.Workspaces(0).OpenDatabase(dbPass) '比較先DBのセット

'比較開始
'↓-----------------------
For Ti = 0 To UBound(ArrTbl)

'レコードセットのオープン
Set Brs = Bdb.OpenRecordset(ArrTbl(Ti), dbOpenSnapshot)
Set Crs = Cdb.OpenRecordset(ArrTbl(Ti), dbOpenSnapshot)

'リンクテーブルを許可しない場合のテーブル確認
If PermitLink = False Then
If Cdb.TableDefs(ArrTbl(Ti)).Connect <> "" Then
strErr = "参照先のテーブルがリンクテーブルです"
GoTo No_Match
end if
End If

'フィールド数の確認
If Brs.Fields.Count <> Crs.Fields.Count Then
strErr = "テーブル構造が異なります"
GoTo No_Match
End If

'フィールド名とフィールドタイプが同一かどうかの確認
For Fi = 0 To Brs.Fields.Count - 1
If Brs.Fields(Fi).Name <> Crs.Fields(Fi).Name Or _
Brs.Fields(Fi).Type <> Crs.Fields(Fi).Type Then

strErr = "テーブル構造が異なります": GoTo No_Match

End If

Next Fi '次のフィールドに移動

'レコードセットを閉じる
Brs.Close
Crs.Close

Next Ti '次のテーブルへ

'↑-----------------------
'比較の終了

Set Brs = Nothing
Set Crs = Nothing
Bdb.Close: Set Bdb = Nothing
Cdb.Close: Set Cdb = Nothing

'完全一致としてプロシージャにTrue(一致)を返す
TblCompare = True

Exit Function

No_Match: '構造が違う場合やリンクテーブルの場合の処理

MsgBox strErr, vbOKOnly + vbExclamation, "エラー"
'プロシージャにFlase(不一致)を返す
TblCompare = False

'クローズ処理
If Not Brs Is Nothing Then Brs.Close: Set Brs = Nothing
If Not Crs Is Nothing Then Crs.Close: Set Crs = Nothing
If Not Bdb Is Nothing Then Bdb.Close: Set Bdb = Nothing
If Not Cdb Is Nothing Then Cdb.Close: Set Cdb = Nothing

Exit Function

errhnd: 'エラー発生時の処理(エラートラップ)

Select Case Err.Number

Case -2147217900 '指定したテーブルが存在しない場合
strErr = "指定されたテーブルが存在しません。"
MsgBox strErr, vbOKOnly + vbExclamation, "エラー"

Case Else
Msgbox "ErrNo:" & Err.Num & chr(13) & "内容:" & Err.Description, _
vbOKOnly + vbExclamation, "エラー"

End Select
TblCompare = False

'エラー時のクローズ処理
If Not Brs Is Nothing Then Brs.Close: Set Brs = Nothing
If Not Crs Is Nothing Then Crs.Close: Set Crs = Nothing
If Not Bdb Is Nothing Then Bdb.Close: Set Bdb = Nothing
If Not Cdb Is Nothing Then Cdb.Close: Set Cdb = Nothing

End Function
・・・長い・・・多分もっと簡略化できるのかも知れません・・・orz

とりあえず、上記を標準プロシージャに記述してしまえば、
後は、比較させたい時に
と記述すると、テーブル構造が同じ場合にTrue、違う場合にはFalseを返してくれます。

テーブル名は「,」で区切って「" "」で括ってもらえれば、、いくつ記述してもOKな筈です。

リンクテーブルの許可は、比較先のテーブルがリンクテーブルでも良い場合に「True」、
リンクテーブルだったらだめな場合には「False」を指定すればよいです。

過去データから、データを引っ張ってくる場合等に利用できるかな~っと
個人的には思っているのですが・・・。

っていうか・・・使える代物なんでしょうか・・・

検索でヒットしてもスルーされてるだけの可能性が高いこのブログ・・・
↑やる気アップにご協力をお願いします。わぁいヽ(∇⌒ヽ)(ノ⌒∇)ノわぁい♪

こんな記事もありますよ


コメントの投稿

非公開コメント

Author's Profile ~自己紹介~

Genzo

Author:Genzo
PCは一応自作できるレベル。
ワード・エクセルなら基本的に
扱えるレベル。
プログラム・・・?ん?
VBA・・・?ん?ん??
それって美味しいですか?


~ 当ブログについて ~

~ Mail2Genzo  ~

Calender&Search かれんだーと検索

09 | 2018/10 | 11
- 1 2 3 4 5 6
7 8 9 10 11 12 13
14 15 16 17 18 19 20
21 22 23 24 25 26 27
28 29 30 31 - - -

Access2Genzo内で検索

Category ~かてごりー~

Comments Tree ~こめんとつりー~


Link ~りんく~

ブロとも申請フォーム

Counter ~かうんた~

Since 2010/08/01:

Online:

タグクラウド

最新トラックバック

上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。