| |
二つのテーブル新TBLと旧TBLが存在します。
この二つのテーブルは全く同じ項目が載っているわけではないので、必要な項目列だけをチェックしたいと思っています
二つのデーブルを比較して、新と旧で中身が変更となっているものはどれなのか？を調べ、
変更TBLに変更を生じた箇所だけをリストアップしていきたいと思ってます。
下記のように作ってみたのですが、途中でどうしてもエラーとなってしまい、先へ進まず悩んでます。
If Mydic.Item(strKey)(u) <> MyVal2(u) Then ’←ココでエラーがでます。（オブジェクトが有効ではありません）
どうかご教授お願いします。
Dictionaryオブジェクトの使い方が間違っているのでしょうか？
Option Compare Database
Sub ChangeData()
'変更した箇所のチェック
Dim rs As ADODB.Recordset
Dim rst As ADODB.Recordset
Dim rsC As ADODB.Recordset
Dim MyVal, MyVal2, MyVal3, MyVal4
Dim lCnt As Long
Dim Mydic As Object
Dim Dic_Change As Object
Dim strKey As String
Dim DC As Long
Set Mydic = CreateObject("scripting.dictionary")
Set Dic_Change = CreateObject("scripting.dictionary")
Set rs = New ADODB.Recordset
rs.CursorType = adOpenKeyset
rs.LockType = adLockReadOnly
Set rst = New ADODB.Recordset
rst.CursorType = adOpenKeyset
rst.LockType = adLockReadOnly
Set rsC = New ADODB.Recordset
rsC.CursorType = adOpenKeyset
rsC.LockType = adLockOptimistic
rs.Open "新TBL", CurrentProject.Connection, , adCmdTable
rst.Open "旧TBL", CurrentProject.Connection, , adCmdTable
rsC.Open "変更List", CurrentProject.Connection, , adCmdTable
旧TBLにデータがあったら差異箇所をチェック
DC = rst.RecordCount
If DC > 0 Then
’新TBLのデータをDictionaryオブジェクトを使用してデータを取得
rs.MoveFirst
Do Until rs.EOF
strKey = rs![KEY]
If Not Mydic.Exists(strKey) Then
MyVal = Array(rs![F1], rs![F2], rs![F3], rs![F4], rs![F5], rs![F6], rs![F7], _
rs![F8], rs![F10], rs![F11], rs![F12], rs![F13], rs![F14], rs![F17])
Mydic.Add strKey, MyVal
End If
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
’もし、新データと同じKeyがあったら、旧データを配列格納し、新データと旧データを比較し、違うものがあれば、新データの値を配列格納し、同じ場合は、””値を格納する
rst.MoveFirst
Do Until rst.EOF
strKey = rst![KEY]
If Mydic.Exists(strKey) Then
MyVal2 = Array(rst![F2], rst![F3], rst![F4], rst![F5], rst![F6], rst![F7], rst![F8], _
rst![F10], rst![F11], rst![F12], rst![F13], rst![F14], rst![F15], rst![F16])
If Mydic.Exists(strKey) Then
For u = 0 To UBound(MyVal2)
If Mydic.Item(strKey)(u) <> MyVal2(u) Then ’←ココでエラーがでます。（オブジェクトが有効ではありません）
lCnt = UBound(MyVal3)
ReDim Preserve MyVal3(lCnt)
MyVal3(lCnt) = Mydic.Item(strKey)(u)’新データを格納
Else
lCnt = UBound(MyVal3)
ReDim Preserve MyVal3(lCnt)
MyVal3(lCnt) = "" ’空白を格納
End If
Next u
End If
Dic_Change.Add strKey, MyVal3
End If
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
Dim MyKey, MyItem
MyKey = Dic_Change.Keys
MyItem = Dic_Change.Items
For i = 0 To UBound(MyKey)
rsC.AddNew
MyVal4 = Array(rsC![F2], rsC![F3], rsC![F4], rsC![F5], rsC![F6], rsC![F7], _
rsC![F8], rsC![F9], rsC![F10], rsC![F11], rsC![F12], rsC![F13], rsC![F14], rsC![F15])
rsC![F1] = MyKey(i)
For u = 0 To UBound(MyVal4)
rsC!MyVal4(u) = Dic_Change(MyKey(u))(u)
Next u
rsC.Update
Next i
rsC.Close
Set rsC = Nothing
Else
rs.Close
Set rs = Nothing
rst.Close
Set rst = Nothing
rsC.Close
Set rsC = Nothing
End If
End Sub
|
|
![[未読]](./data/access/image/read_icon.gif){kind=icon}
