ACCESS VBA MSが教えてくれないテーブルに主キー(Primary Key)index Fieldを追加する方法

# マイクロソフトの公式解説はバグが発生する
[インデックスを作成および修正する](https://msdn.microsoft.com/ja-jp/library/cc376284.aspx)
Microsoft Office 2000/Visual Basic プログラマーズ ガイド 	ADO を使用して Access データベースの構造を作成、変更、および表示するに次のような例が載っている
<blockquote>

```vb
Sub CreateIndex(strDbPath As String, _
         strTblToIdx As String, _
         strIdxName As String, _
         strIdxField As String, _
         lngIndexNulls As ADOX.AllowNullsEnum, _
         lngSortOrder As ADOX.SortOrderEnum)
   Dim catDB As ADOX.Catalog
   Dim tbl As ADOX.Table
   Dim idx As ADOX.Index

   Set catDB = New ADOX.Catalog
   ' インデックスを作成するデータベースのカタログを開きます。
   catDB.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                            "Data Source=" & strDbPath
   Set tbl = New ADOX.Table
   Set tbl = catDB.Tables(strTblToIdx)

   ' Index オブジェクトを作成し、テーブル列に関連付けます。
   Set idx = New ADOX.Index
   With idx
      .Name = strIdxName
      .IndexNulls = lngIndexNulls
      .Columns.Append strIdxField
      .Columns(strIdxField).SortOrder = lngSortOrder
   End With

   ' Index オブジェクトを Table オブジェクトの Indexes コレクションに関連付けます。
   tbl.Indexes.Append idx

   Set catDB = Nothing
End Sub

'たとえば、CreateIndex プロシージャを使用して、Employee テーブルの Country フィールドを昇順に並べ替えて、Null を使用できるインデックスを作成するには、次のようなコードを使用します。

CreateIndex _
   "C:\Program Files\Microsoft Office\Office\Samples\Nwind.mdb", _
   "Employees", "CountryIndex", "Country", _
              "adIndexNullsIgnore","adSortAscending"

```

</blockquote>

しかし、初心者にはわかりにくいが、このVBA、を

```vb
  Set catDB = New ADOX.Catalog
   ' インデックスを作成するデータベースのカタログを開きます。
   catDB.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                            "Data Source=" & strDbPath
```

Accdbの現在はプロバイダーが違う。
次に、このVBA「今開いているデータベースのテーブルにインデックスをつけようとしてもエラーになります。メッセージは「記憶領域が足りません」

## カレントのデータベースのテーブルにインデックスをつける
### 作業の流れ
<OL>
<li>テーブルの名前をListとします。
2.追加するインデックスのフィールド名をID,データ形式はオートナンバーです。
3.これを追加して、次に2番目の列に移動します。
4.2番目の列に移動したら、1番目の列を2番目にすることにより入れ替えます。

###注意点
- 事前にADOXとADODBを参照指定する。
- テーブルには主キーが存在せず、「ID」という名前のフィールド（列）が存在しないこと
- 出来上がる主キーは重複を許さない、空白を許さないものになること

ADOXとADODB はいらないと言えばいらないのですが、比較するときに使ったり、ネットでは別の方法もありますので、先を見越して、追加しています。

```vb
Sub AddIndexFieldOfPrimaryKeyColumn()
Dim TName As String: TName = "ListMain"
Dim fldName As String : fldName = "ID"
Dim cDb As DAO.Database: Set cDb = CurrentDb
Dim Cat As ADOX.Catalog: Set Cat = New ADOX.Catalog
Dim cn As ADODB.Connection
Dim CTbl As ADOX.Table
Dim sSQL As String
Dim fld0 As Field, fld1 As DAO.Field
Dim i0 As Long, i1 As Long
Dim idx As ADOX.Index, idxs As ADOX.Indexes, cCol As ADOX.Column, cCOLS As ADOX.Columns, cGrs As ADOX.Groups, CGr As ADOX.Group, cKeys As ADOX.Keys, cKey As ADOX.Key
Call CloseAllAccessObject
Cat.ActiveConnection = CurrentProject.Connection
Set CTbl = Cat.Tables(TName)
sSQL = "ALTER TABLE " & TName & " ADD COLUMN ID COUNTER PRIMARY KEY"
DoCmd.RunSQL sSQL 'この状態ではID列は最も右側に位置している
On Error Resume Next
Set fld0 = cDb.TableDefs(TName).Fields(fldName)
fld0.OrdinalPosition = 0 ’この命令で左から2番目に移動する
Set fld1 = cDb.TableDefs(TName).Fields(0) ’一番左側のフィールド(列）を指定
fld1.OrdinalPosition = 1　'2番目に持ってくることでID列が一番左(アクセスは0番から列をカウントするので物理的な列の位置-1となる)
Set Cat = Nothing
End Sub
```
#STACK OVERFLOWのSQL(ALTER TABLE)を使う方法
https://stackoverflow.com/questions/24238068/access-sql-alter-column-to-autonumber

```vbnet
 ALTER TABLE PERSON ALTER COLUMN PERSON_ID COUNTER PRIMARY KEY 
```
というSQL(アクションクエリ)を使う方法があるが、これはデータがない空のテーブルでないと使えない。

この意味はPERSONというテーブルのPERSON_IDという列(フィールド)を主キーに変更するという意味になる。
#Adoxで一度成功した手法
テーブルを開く必要がある

```vb
Sub Sample
Dim myCat As ADOX.Catalog: Set myCat = New ADOX.Catalog
Dim idx As ADOX.Index, idxs As ADOX.Indexes, cCol As ADOX.Column, cCOLS As ADOX.Columns, cGrs As ADOX.Groups, CGr As ADOX.Group, cKeys As ADOX.Keys, cKey As ADOX.Key
Dim tdNew As ADOX.Table
myCat.ActiveConnection = CN
fldName = "ID"
Set tdNew = myCat.Tables(TName)
tdNew.Columns.Append "ID", adInteger
' Index オブジェクトを作成し、テーブル列に関連付けます。
Set IDX = New ADOX.Index
With IDX
.Name = "ID"
.PrimaryKey = True
.Columns.Append "ID"
.Columns.Refresh
End With
tdNew.Columns.Refresh
IDX.Columns.Refresh
myCat.Tables.Refresh
Application.RefreshDatabaseWindow: DoEvents
DoCmd.OpenTable TName, acViewDesign 'デザインビューとして開く
DoCmd.Save acTable, TName '保存　この動作をしないと定着しない
DoCmd.Close
End Sub
```

#Daoを使う方法
ADOXがエラーになるのは、データが入っていないテーブルを前提としており、データが入っているテーブル、フィールドにインデックスをつけられないということがわかった。

```vb
Sub ImportTableAndAddPrimary
'For Access VBA
'CurrentProject.Path Import.xlsxをインポートして、No（ナンバーフィールド）を主キーにする
Dim cDB As Dao.Database : Set cDB = CurrentDb
Dim TDf As Dao.TableDef
Dim idx As Dao.Index, idxs As Dao.Indexes
Dim fld As Dao.Field, flds As Dao.Fields

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName:=TName, FileName:=CurrentProject.Path & " import.xlsx", hasfieldnames:=True 'なぜか小文字になる
DoEvents
cDB.TableDefs.Refresh: DoEvents
Application.RefreshDatabaseWindow: DoEvents
Set TDf = cDB.TableDefs(TName)
Set idx = TDf.CreateIndex("Get_ID")
' http://www.accessclub.jp/dao/21.html
idx.Primary = True 'これをつけないと主キーにならない
TDf.Indexes.Refresh
Set flid = idx.CreateField("No")
idx.Fields.Refresh
idx.Fields.Append flid
TDf.Indexes.Append idx
TDf.Indexes.Refresh
cDB.TableDefs.Refresh
End Sub
```

# Daoその２ID列を追加して順番を変える方法(2022/07/24追加)
MS Access Tips How To On Table Create "ID" Field With Primary And Set First Position
上記のプロパティで移動させる手法が使えるようだ。
[Access VBA to Set Field Location](https://stackoverflow.com/questions/46431954/access-vba-to-set-field-location)
一番最後に作って、0とすると最初に来る。
このとき、なぜかfldsのような変数を使わず、CurrentDbから記述すると成功する。
もちろんこうした例は検討していたが、ふとStackOverFlowをみてなんとなくCurrentDbから記述したら成功した。
ただし、この移動量はいくつくらいか。列数が大きいときは定義が多すぎますエラーが出るかもしれない。単純に変更するだけなら1だが、移動するとなると、ほかを全部入れ替えていないか。そうするとはね上がる。

```vb
Sub ADDPrimaryKeyFieldAndChangePosition()
Dim cDB As DAO.Database:: Set cDB = CurrentDb
Dim fld0 As DAO.Field, fld1 As DAO.Field
Dim fldName As String
Dim tName As String
tName = "T_PartB"
fldName = "ID"
DoCmd.RunSQL "ALTER TABLE  [" & tName & "] ADD COLUMN [" & fldName & "] Counter PRIMARY KEY;"
CurrentDb.TableDefs(tName).Fields(fldName).OrdinalPosition = 0 ' なぜかこのように指定したら成功
CurrentDb.TableDefs(tName).Fields.Refresh
CurrentDb.TableDefs.Refresh
End Sub
```