引き継いだAccessのシステムが激遅な件

15年近く前に外注に出したAccessのシステムの保守を引き継いだ
データのサイズは400MBを超えていて、数万件のデータから1レコードを検索をしようと思ったら1分近くかかるシステムだった。
外注の書いたコードか前任者の追加コードが原因かは今となってはわからない（仕様書もない）が
VBAソースコードを見直してみたらナポリタンの匂いがした

TCP Monitor Plusをダウンロードして、ファイルサーバーとクライアントPCのパケットをモニタリングしてみたところ1レコードの検索で80MBのデータを受信していることが判明(/・ω・)/

見直しをしてみたらテーブルのフィールドに適切なインデックスが設定されておらずRecordsetでFilter使いまくりだった

Indexの有無とFilter使った場合でどんだけ違うのかをテストしてみた

新しいAccessファイルを作りテーブル１にフィールド1～6を追加
フィールド1はインデックスをはい (重複あり)に指定

下のコードで500000件のテストデータを入れ込んだ

view plainprint?

1. Option Compare Database  
2. Option Explicit  
3.   
4. Sub TestData()  
5.   
6.     Dim db As DAO.Database  
7.     Set db = CurrentDb  
8.     
9.     Dim l As Long  
10.     For l = 0 To 500000  
11.         
12.         db.Execute ("INSERT INTO テーブル1 (フィールド1,フィールド2,フィールド3,フィールド4,フィールド5,フィールド6) " & _  
13.                     "VALUES ('" & GetGUID() & "','" & GetGUID() & "','" & GetGUID() & "','" & GetGUID() & "','" & GetGUID() & "','" & GetGUID() & "')")  
14.     
15.     Next  
16.   
17. End Sub  
18.   
19. '下のサイトを参考にさせてもらいました  
20. 'http://maeda0414.blog.fc2.com/blog-entry-26.html  
21. Public Function GetGUID() As String  
22.     GetGUID = Mid$(CreateObject("Scriptlet.TypeLib").Guid, 2, 36)  
23. End Function  

Option Compare Database
Option Explicit

Sub TestData()

    Dim db As DAO.Database
    Set db = CurrentDb
  
    Dim l As Long
    For l = 0 To 500000
      
        db.Execute ("INSERT INTO テーブル1 (フィールド1,フィールド2,フィールド3,フィールド4,フィールド5,フィールド6) " & _
                    "VALUES ('" & GetGUID() & "','" & GetGUID() & "','" & GetGUID() & "','" & GetGUID() & "','" & GetGUID() & "','" & GetGUID() & "')")
  
    Next

End Sub

'下のサイトを参考にさせてもらいました
'http://maeda0414.blog.fc2.com/blog-entry-26.html
Public Function GetGUID() As String
    GetGUID = Mid$(CreateObject("Scriptlet.TypeLib").Guid, 2, 36)
End Function

このファイルをファイルサーバに置き
クライアント側にも新しいAccessファイルを作りモジュールに下のテストコードを書く

view plainprint?

1. Option Compare Database  
2. Option Explicit  
3.   
4. Public Sub Test1()  
5.   
6.     Dim db As DAO.Database  
7.     Dim rs As DAO.Recordset  
8.     
9.     Set db = CurrentDb  
10.     
11.     'インデックスを設定したフィールドを条件にして直にクエリ文を書いた  
12.     Set rs = db.OpenRecordset("SELECT * FROM テーブル1 WHERE フィールド1 = '884EBDD8-0516-480D-9C13-6F2EF60B2202'")  
13.       
14.     Do Until rs.EOF  
15.         Debug.Print ("Test1 " & rs!ID)  
16.         rs.MoveNext  
17.     Loop  
18.     
19. End Sub  
20.   
21. Public Sub Test2()  
22.   
23.     Dim db As DAO.Database  
24.     Dim rs As DAO.Recordset  
25.     
26.     Set db = CurrentDb  
27.     
28.     'インデックスの設定をしていないフィールドを条件にして直にクエリ文を書いた  
29.     Set rs = db.OpenRecordset("SELECT * FROM テーブル1 WHERE フィールド2 = '7BFD061C-711E-404F-89D3-0973CADFF5F6'")  
30.       
31.     Do Until rs.EOF  
32.         Debug.Print ("Test2 " & rs!ID)  
33.         rs.MoveNext  
34.     Loop  
35.         
36. End Sub  
37.   
38. Public Sub Test3()  
39.   
40.     Dim db As DAO.Database  
41.     Dim rs As DAO.Recordset  
42.     
43.     Set db = CurrentDb  
44.     
45.     'Filterプロパティにインデックスを設定したフィールドの条件を書いた  
46.     Set rs = db.OpenRecordset("テーブル1")  
47.     rs.Filter = "フィールド1 = '884EBDD8-0516-480D-9C13-6F2EF60B2202'"  
48.     Set rs = rs.OpenRecordset  
49.       
50.     Do Until rs.EOF  
51.         Debug.Print ("Test3 " & rs!ID)  
52.         rs.MoveNext  
53.     Loop  
54.     
55. End Sub  
56.   
57. Public Sub Test4()  
58.     
59.     Dim db As DAO.Database  
60.     Dim rs As DAO.Recordset  
61.     
62.     Set db = CurrentDb  
63.     
64.     'Filterプロパティにインデックスの設定していないフィールドの条件を書いた  
65.     Set rs = db.OpenRecordset("SELECT * FROM テーブル1 WHERE フィールド2 = '7BFD061C-711E-404F-89D3-0973CADFF5F6'")  
66.       
67.     Set rs = db.OpenRecordset("テーブル1")  
68.     rs.Filter = "フィールド2 = '7BFD061C-711E-404F-89D3-0973CADFF5F6'"  
69.     Set rs = rs.OpenRecordset  
70.     Do Until rs.EOF  
71.         Debug.Print ("Test4 " & rs!ID)  
72.         rs.MoveNext  
73.     Loop  
74.         
75. End Sub  

Option Compare Database
Option Explicit

Public Sub Test1()

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
  
    Set db = CurrentDb
  
    'インデックスを設定したフィールドを条件にして直にクエリ文を書いた
    Set rs = db.OpenRecordset("SELECT * FROM テーブル1 WHERE フィールド1 = '884EBDD8-0516-480D-9C13-6F2EF60B2202'")
    
    Do Until rs.EOF
        Debug.Print ("Test1 " & rs!ID)
        rs.MoveNext
    Loop
  
End Sub

Public Sub Test2()

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
  
    Set db = CurrentDb
  
    'インデックスの設定をしていないフィールドを条件にして直にクエリ文を書いた
    Set rs = db.OpenRecordset("SELECT * FROM テーブル1 WHERE フィールド2 = '7BFD061C-711E-404F-89D3-0973CADFF5F6'")
    
    Do Until rs.EOF
        Debug.Print ("Test2 " & rs!ID)
        rs.MoveNext
    Loop
      
End Sub

Public Sub Test3()

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
  
    Set db = CurrentDb
  
    'Filterプロパティにインデックスを設定したフィールドの条件を書いた
    Set rs = db.OpenRecordset("テーブル1")
    rs.Filter = "フィールド1 = '884EBDD8-0516-480D-9C13-6F2EF60B2202'"
    Set rs = rs.OpenRecordset
    
    Do Until rs.EOF
        Debug.Print ("Test3 " & rs!ID)
        rs.MoveNext
    Loop
  
End Sub

Public Sub Test4()
  
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
  
    Set db = CurrentDb
  
    'Filterプロパティにインデックスの設定していないフィールドの条件を書いた
    Set rs = db.OpenRecordset("SELECT * FROM テーブル1 WHERE フィールド2 = '7BFD061C-711E-404F-89D3-0973CADFF5F6'")
    
    Set rs = db.OpenRecordset("テーブル1")
    rs.Filter = "フィールド2 = '7BFD061C-711E-404F-89D3-0973CADFF5F6'"
    Set rs = rs.OpenRecordset
    Do Until rs.EOF
        Debug.Print ("Test4 " & rs!ID)
        rs.MoveNext
    Loop
      
End Sub

リンクテーブルを張ってテスト

結果
Test1 送受信量 226KB
Test2 送受信量 153MB
Test3 送受信量 157MB
Test4 送受信量 157MB

まとめ
適切なインデックス設定を行う事とRecordsetのFilterは使わないと心に誓った