Access2003/指定されたテーブルから削除できませんでした

ＦＳ社の Access「月次処理」の改修で、コーディングを終え検証したら‥‥

モジュールで SQLを実行した時に出ることが判ったので、SQLをクエリーに貼り付け、実行してみた‥‥ ら、同じエラーが出た。

ググったら、Office.Microsoft.comに、次のようにあった。

"指定されたテーブルから削除できませんでした。" というエラー メッセージが表示される
　1 回の操作でテーブルから複数のレコードを削除するには、削除クエリを使用します。削除クエリの処理が正常に行われるのは、以下の場合です。

1. 他のテーブルとリレーションシップのない単一のテーブルを対象としている場合。

• 一対一リレーションシップを持つ 2 つのテーブルを組み合わせている場合。
• 一対多リレーションシップの "一" の側の単一のテーブルを使用しており、かつ、そのリレーションシップで連鎖削除が有効になっている場合。
• 一対多リレーションシップの "一" の側のテーブルと、同じリレーションシップの "多" の側のテーブルの両方が含まれている (たとえば、"多" の側のテーブルのフィールドに基づく抽出条件を使用している) 場合。

自分のケースは 2. に反していると思われる。
で、「ADOで処理するしかない」が、この10年間使っていないしなぁ...

■　Find か Seek か

• VB データ アクセスのための比較が、Find メソッドとシーク　（Support.Microsoft.com）

  　Seek と find メソッドは、適用するレコードの種類では、パフォーマンスに違いがあります。

  • Find メソッド (FindFirst、FindLast、FindNext、および FindPrevious) はダイナセットとスナップショットにはテーブル オブジェクトに適用されます。逆に、Seek メソッドは、Table オブジェクトでのみ使用できます。
  • Seek メソッドは、find メソッドよりも大幅に高速です。シークの順序を変更するには、Table オブジェクトのインデックス プロパティを変更するためにもより柔軟です。集中的な検索は、find メソッドと Seek メソッドを使用するには、開いているダイナセットにするようにテーブル オブジェクトを作成する可能性があります。

• レコード検索（ADO編)　（Access_VBA講座）

  ０１.Findメソッド
  　Recordset から指定した条件を満たすレコードを検索します。条件が一致すれば、そのレコードをカレントレコードにします。それ以外のときは，RecordsetオブジェクトのBOFプロパティまたはEOFプロパティがTrueになり，カレントレコードは未定義になります。
  【書式】 recordset.Find Criteria, SkipRows, SearchDirection, Start０４.Seekメソッド
  　Seekメソッドはテーブルに設定されているインデックスを利用して検索を行うため，Findメソッドよりも高速にレコードを検索できます。RecordsetオブジェクトのOpenメソッドのoptions引数にadCmdTableDirectを指定して作成したRecordsetオブジェクトだけで実行可能です。
  【書式】 recordset.Seek KeyValues, SeekOption

■　結果
Seekを使うにはテーブル オブジェクトを作る必要があるが、その時間を入れても Seekの方が早い‥‥ と、判断した。
色々制約があり、試行錯誤した結果、下記コードで目的を達した。（所要時間 約 6時間）

1. Public Function update作業日報(arg削除期限 As Date) As Boolean
2. On Error GoTo Err_update作業日報
3. Dim mbTitle As String
4. Dim CNN As New ADODB.Connection
5. Dim RST As New ADODB.Recordset, RS0 As New ADODB.Recordset
6. Dim isDrop As Boolean
7. Dim maxCTR As Long, setCTR As Long
8. Dim SQLCmd As String, strSQL As String, rs0SQL As String
9. 　
10. mbTitle = "update作業日報/" & MYObjName
11. maxCTR = DCount("*", "D_作業日報")
12. VARAns = SysCmd(acSysCmdSetStatus, "月次処理/作業日報 更新中： " & maxCTR)
13. 'D_作業指図の受付Noのテーブルを作成する。（リンクテーブルでは不可）
14. DoCmd.SetWarnings False
15. strSQL = "Delete tmp受付No.* from tmp受付No"
16. DoCmd.RunSQL strSQL
17. strSQL = "Insert into tmp受付No (受付No) Select 受付No from D_作業指図" _
18. & " Where ([受付No]　Is Not Null)"
19. DoCmd.RunSQL strSQL
20. DoCmd.SetWarnings True
21. 'D_作業日報を1件ずつ読み、削除対象は所属コードに"$"を付け加える。
22. Set CNN = CurrentProject.Connection
23. RS0.Open "tmp受付No", CNN, adOpenKeyset, adLockOptimistic, adCmdTableDirect
24. RS0.Index = "受付No"
25. strSQL = "Select 所属コード, 受付No, 作業月日 from D_作業日報"
26. RST.Open strSQL, CNN, adOpenDynamic, adLockOptimistic
27. setCTR = 0
28. Do Until RST.EOF
29. VARAns = SysCmd(acSysCmdSetStatus, "月次処理/作業日報 更新中： " & maxCTR)
30. isDrop = False
31. If IsNull(RST!受付No) Then
32. VARAns = RST!作業月日
33. If Not IsNull(VARAns) Then
34. If CDate(VARAns) <= arg削除期限 Then isDrop = True
35. End If
36. Else
37. '受付Noがあるか否かSeekする。
38. RS0.Seek RST!受付No, adSeekFirstEQ
39. If RS0.EOF Then isDrop = True
40. End If
41. If isDrop Then
42. VARAns = RST!所属コード
43. If IsNull(VARAns) Then
44. RST!所属コード = "$"
45. ElseIf Len(VARAns) = 1 Then
46. RST!所属コード = VARAns & "$"
47. Else
48. MsgBox "作業日報の更新に失敗しました。システム管理者に連絡してください。", vbCritical, mbTitle
49. GoTo Exit_update作業日報
50. End If
51. RST.Update
52. setCTR = setCTR + 1
53. End If
54. RST.MoveNext
55. maxCTR = maxCTR - 1
56. Loop
57. RST.Close
58. RS0.Close
59. '累積に追加して落とす。
60. '　　DoCmd.SetWarnings False
61. DoCmd.OpenQuery "Q_作業日報を累積に追加する"
62. DoEvents
63. 'D_作業日報から削除する。
64. SQLCmd = "Delete * from D_作業日報 Where (Right([所属コード],1)='$')"
65. DoCmd.RunSQL SQLCmd
66. DoEvents
67. update作業日報 = True
68. 　
69. Exit_update作業日報:
70. DoCmd.SetWarnings True
71. Set CNN = Nothing
72. Exit Function
73. 　
74. Err_update作業日報:
75. MsgBox Err.Number & "/" & Err.Description, vbCritical, mbTitle
76. Resume Exit_update作業日報
77. End Function