アクセスのテーブルにインデックスを追加・削除する

　インデックスが振られていないアクセスのテーブルからデータを抽出していたら５分以上かかったり、メモリー不足です的な謎のエラーが頻発したり。
　じゃ、抽出する前にテーブルにインデックスを追加すればいいんじゃね？ということでググってみたら、msdnにコードが紹介されているんだけど、更新されていなくてそもそもExcel 2016では動かないし、ひとつのテーブルにひとつのインデックスを追加するという内容でイマイチ。
　複数のフィールドにインデックスを付けられた方が便利なので、フィールドを配列にした上で、このmsdnのサンプルをExcel 2016で動くように書き直しました。

インデックスの追加

呼び出し側

データは構造体にして処理ルーチンに渡すことにしました。

    Option Explicit
    
    Type DbInfo
        FullName        As String
        TableToIndex    As String
    End Type
        
    Type IndexInfo
        Field           As String
        Name            As String
        Nulls           As ADOX.AllowNullsEnum
        SortOrder       As ADOX.SortOrderEnum
    End Type

    Sub Accessのテーブルにインデックスを追加()
        
        Dim DB As DbInfo
        Dim Index(1) As IndexInfo
        
        DB.FullName = "C:\Users\user\Desktop\blog用\Database1.accdb"
        DB.TableToIndex = "Table_1"
        Index(0).Field = "性別"
        Index(1).Field = "都道府県"
        Index(0).Name = "Idx性別"
        Index(1).Name = "Idx都道府県"
        Index(0).Nulls = adIndexNullsDisallow
        Index(1).Nulls = adIndexNullsDisallow
        Index(0).SortOrder = adSortAscending
        Index(1).SortOrder = adSortAscending
        
        Call CreateIndex(DB, Index)
    
    End Sub

処理ルーチン

参照設定の ADO, ADOX のバージョンの選択については、特に裏付けはとってないです

'   参照設定                                                             '
'   Microsoft ActiveX Data Objects 6.1 Library                           '
'   Microsoft ADO Ext 6.0 for DDL and Security                           '
'========================================================================='
    Sub CreateIndex( _
        ByRef pDb As DbInfo, _
        ByRef pIdx() As IndexInfo _
    )
'========================================================================='
        Dim catDB As New ADOX.Catalog
        Dim tbl As New ADOX.Table
        Dim Idx() As ADOX.Index
        Dim i As Integer
        Dim j As Integer
    
      ''インデックスを作成するデータベースのカタログを開きます。
        catDB.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                 "Data Source=" & pDb.FullName
        Set tbl = catDB.Tables(pDb.TableToIndex)
    
        For i = LBound(pIdx) To UBound(pIdx)
          ''フィールドにインデックスが振られているかどうかの判定
            For j = 0 To (tbl.Indexes.Count - 1)
                If tbl.Indexes.Item(j).Columns.Item(0).Name = pIdx(i).Field Then
                    Exit For
                End If
            Next j
          ''インデックスが設定されていないと、j = tbl.Indexes.Countになる
            If j = tbl.Indexes.Count Then
              ''Index オブジェクトを作成し、テーブル列に関連付けます。
                ReDim Preserve Idx(i)
                Set Idx(i) = New ADOX.Index
                With Idx(i)
                   .Name = pIdx(i).Name
                   .IndexNulls = pIdx(i).Nulls
                   .Columns.Append pIdx(i).Field
                   .Columns(pIdx(i).Field).SortOrder = pIdx(i).SortOrder
                End With
              ''Index オブジェクトを Table オブジェクトの Indexes コレクションに
              ''関連付けます｡
                tbl.Indexes.Append Idx(i)
            End If
        Next i
        Set catDB = Nothing
    End Sub

インデックスの削除

呼び出し側

インデックスを削除するルーチンを追加しました（2019/01)

    Sub 追加したインデックスを削除()
        
        Dim DB As DbInfo
        Dim Index(1) As IndexInfo
        
        DB.FullName = "C:\Users\user\Desktop\blog用\Database1.accdb"
        DB.TableToIndex = "dummy"
        Index(0).Name = "Idx性別"
        Index(1).Name = "Idx都道府県"
        
        Call DeleteIndex(DB, Index)
    
    End Sub

処理ルーチン

'   参照設定                                                             '
'   Microsoft ActiveX Data Objects 6.1 Library                           '
'   Microsoft ADO Ext 6.0 for DDL and Security                           '
'========================================================================='
    Sub DeleteIndex( _
        ByRef pDb As DbInfo, _
        ByRef pIdx() As IndexInfo _
    )
'========================================================================='
        Dim catDB As New ADOX.Catalog
        Dim tbl As New ADOX.Table
        Dim Idx() As ADOX.Index
        Dim i As Integer
        Dim j As Integer
    
        catDB.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                 "Data Source=" & pDb.FullName
        Set tbl = catDB.Tables(pDb.TableToIndex)
    
        For i = LBound(pIdx) To UBound(pIdx)
            For j = 0 To (tbl.Indexes.Count - 1)
                If tbl.Indexes.Item(j).Name = pIdx(i).Name Then
                    tbl.Indexes.Delete pIdx(i).Name
                    Exit For
                End If
            Next j
        Next i
        Set catDB = Nothing
    End Sub