ACCESS VBAのMoveメソッドがおかしいのでは？

質問

ACCESS2000のVBA、Moveがおかしいです。

"通番"(数値型)フィールドを持つ"テーブル1"に、レコード通番を埋め込む(更新)というプログラムです。
事情があって10レコード毎に処理を繰り返すのですが、レコード数が501の場合に実行時エラー'3021'になります。502や500レコードの場合は問題無し。

どうやら、moveで501レコード目に飛んで最終行だった場合、EOFがTrueになってしまっているようです（EOFは次の行なのに）。

Public Function koshin()

Const bunkatsu = 10 '１処理の区切りとなるレコード数
Dim rcd As New ADODB.Recordset
Dim no As Long '処理用内部変数
Dim recno As Long 'テーブルのレコード数
Dim rep As Long '処理の繰り返し数

rcd.Open "テーブル1", CurrentProject.Connection, adOpenKeyset, adLockPessimistic
recno = rcd.RecordCount 'レコード数を取得する
rcd.Close

MsgBox "レコード数は" & recno & "です"
no = 0
rep = -Int(-(recno / bunkatsu)) '分割回数を算出する
MsgBox "内部処理を" & rep & "回分割して行います"

For i = 0 To rep - 1

rcd.Open "テーブル1", CurrentProject.Connection, adOpenKeyset, adLockPessimistic
rcd.Move i * bunkatsu

For j = 1 To bunkatsu
no = no + 1
rcd![通番].Value = no
rcd.Update
rcd.MoveNext
If rcd.EOF Then Exit For
Next j

rcd.Close
SysCmd acSysCmdSetStatus, no & "件処理しました"

Next i

MsgBox "終了しました"

End Function

回答No.3

AlexSuns · ベストアンサー

シンプルな再現方法

'--------------------------------------------------
再現環境作成：

テーブル：test
フィールド：ID ,オートナンバー型
フィールド：通番, 数値型

※このテーブルに501件のデータを登録

※以下登録コードサンプル
　　Dim i As Integer
　　For i = 0 To 500
　　　　CurrentDb.Execute "insert into test ([通番]) values (" & i & ");"
　　Next i

'--------------------------------------------------
不具合再現コード：

　　Dim rcd As New ADODB.Recordset

　　rcd.Open "test", CurrentProject.Connection, adOpenKeyset, adLockPessimistic
　　rcd.Move 500

　　rcd![通番].Value = 777 '※ここでエラー発生
　　rcd.Update

　　rcd.Close

'--------------------------------------------------

上記方法で試したところ、確かに再現しますね。
しかも言われている通り、501件のときのみ発生しました。
(500件周辺のみ確認しました)

エラーになったときにイミディエイトウィンドウにて確認したところ、カレントレコードはEOFの位置にいました。
試しにイミディエイトウィンドウにて、MovePreviousしてみると、501件目のデータでした。

上記のことより何らかの理由により、501件目が飛ばされるようですね。
(あきらかにMoveメソッドのバグだと思われます)

今回の例では501件目だけでしたが、他にも特定のレコード件数にてあると思われます

ロジックを見直して代替手段を考えたほうが宜しいかと思われます

回答No.2

noname#79209

分割数（この例では10）毎にレコードセットをOpen、Closeしているので、
外側のForループでMoveメソッドを使って目的のレコードへジャンプする必要が生じていますね。
#1さんが指摘しているような、１からbunnkatuまでの連番を繰り返し
振るのではなく、全レコードに連続した番号を振りたいのなら
以下で、如何でしょう。

rcd.Open "テーブル1", CurrentProject.Connection, adOpenKeyset, adLockPessimistic
no=1
Do Until rcd.EOF
rcd![通番].Value = no
rcd.Update
no = no + 1
if no Mod bunkatu = 1 Then
'必要なら、ここにブロック（ブレーク）毎の処理を入れる
SysCmd acSysCmdSetStatus, no-1 & "件処理しました"
End If
rcd.MoveNext
loop
MsgBox "終了しました。"　& no-1 & "件処理しました"
If no Mod bunkatu > 1 Then
'必要なら、ここに最終ブロック（ブレーク）の処理を入れる
End If

rcd.Close

回答No.1

noname#22222

このような処理を行いたいのでしょうか...

Private Sub コマンド6_Click()
　　Const bunkatsu = 10 '１処理の区切りとなるレコード数
　　Dim I　　 As Integer
　　Dim rcd　 As New ADODB.Recordset
　　Dim no　　As Long '処理用内部変数
　　Dim recno As Long 'テーブルのレコード数

　　With rcd
　　　　.Open "テーブル1", CurrentProject.Connection, adOpenKeyset, adLockPessimistic
　　　　recno = .RecordCount
　　　　For I = 1 To recno
　　　　　　no = (no Mod bunkatsu) + 1
　　　　　　.Fields("通番").Value = no
　　　　　　.Update
　　　　　　.MoveNext
　　　　Next I
　　　　.Close
　　End With
End Sub