じゃ、抽出する前にテーブルにインデックスを追加すればいいんじゃね?ということでググってみたら、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
0 件のコメント:
コメントを投稿