Access2000のVBAコードの最適化
お世話になります。
Access2000のVBAでコードを作成したのですが、
処理をもっと早く出来る方法ありましたら教えて頂ければと
思います。
処理している内容としては、
(1)データ元のエクセルファイルを開く
(2)エクセルファイルに記載されているセルの内容をAccessに挿入
※取り込み開始・終了が200回程繰り返す
※While (oApp.Sheets(sheet).cells(iRow, 1) <> "")のループは500回程繰り返す
少しでも処理を速くする方法があれば教えて頂きたいので
宜しくお願い致します。
------------ソース----------------
Set oApp = CreateObject("Excel.Application")
oApp.Workbooks.Open FileName:=CurrentProject.Path & "\メイン.xlsm"
---------------取り込み開始-------------
rs2.Open "選手", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
iRow = 2
sheet = "program"
rs.Open "選手情報_選手ID", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
iRow = 2 ' ★
sheet = "program"
While (oApp.Sheets(sheet).cells(iRow, 1) <> "")
rs.Filter = "日=" & oApp.Sheets(sheet).cells(iRow, 2)
rs.Filter = rs.Filter & " and 場=" & oApp.Sheets(sheet).cells(iRow, 1)
rs.Filter = rs.Filter & " and 番号=" & oApp.Sheets(sheet).cells(iRow, 3)
If (rs.EOF) Then
rs.AddNew
rs("日") = oApp.Sheets(sheet).cells(iRow, 2)
rs("場") = oApp.Sheets(sheet).cells(iRow, 1)
rs("番号") = oApp.Sheets(sheet).cells(iRow, 3)
End If
rs("1番") = oApp.Sheets(sheet).cells(iRow, 5)
rs("2番") = oApp.Sheets(sheet).cells(iRow, 5 + 26)
rs("3番") = oApp.Sheets(sheet).cells(iRow, 5 + 26 + 26)
rs("4番") = oApp.Sheets(sheet).cells(iRow, 5 + 26 + 26 + 26)
rs("5番") = oApp.Sheets(sheet).cells(iRow, 5 + 26 + 26 + 26 + 26)
rs("6番") = oApp.Sheets(sheet).cells(iRow, 5 + 26 + 26 + 26 + 26 + 26)
rs.Update
iRow = iRow + 1
Wend
rs.Close
---------------取り込み終了-------------
---------------取り込み開始-------------
rs.Open "選手情報_選手名", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
iRow = 2 ' ★
sheet = "program"
While (oApp.Sheets(sheet).cells(iRow, 1) <> "")
rs.Filter = "日=" & oApp.Sheets(sheet).cells(iRow, 2)
rs.Filter = rs.Filter & " and 場=" & oApp.Sheets(sheet).cells(iRow, 1)
rs.Filter = rs.Filter & " and 番号=" & oApp.Sheets(sheet).cells(iRow, 3)
If (rs.EOF) Then
rs.AddNew
rs("日") = oApp.Sheets(sheet).cells(iRow, 2)
rs("場") = oApp.Sheets(sheet).cells(iRow, 1)
rs("番号") = oApp.Sheets(sheet).cells(iRow, 3)
End If
rs("1番") = oApp.Sheets(sheet).cells(iRow, 1 + 5)
rs("2番") = oApp.Sheets(sheet).cells(iRow, 1 + 5 + 26)
rs("3番") = oApp.Sheets(sheet).cells(iRow, 1 + 5 + 26 + 26)
rs("4番") = oApp.Sheets(sheet).cells(iRow, 1 + 5 + 26 + 26 + 26)
rs("5番") = oApp.Sheets(sheet).cells(iRow, 1 + 5 + 26 + 26 + 26 + 26)
rs("6番") = oApp.Sheets(sheet).cells(iRow, 1 + 5 + 26 + 26 + 26 + 26 + 26)
rs.Update
iRow = iRow + 1
Wend
rs.Close
---------------取り込み終了-------------
お礼
お返事が遅くなり申し訳ありません。実は補足を記入したつもりだったのですが、きちんと反映できなかったようです。 ご回答ありがとうございました。参照設定をチェックしたところ、こちらは問題ないようでした。 アクセスの基礎がまだまだなので、質問もあいまいで申し訳ありません。質問させていただいた課題(アクセスの修正)の仕事が先送りになりましたので、もう少し勉強してから改めてご質問いたします。 ありがとうございました。