ADOX 複数回フィールドを定義することは出来ませ

質問

アクセス２０１０ですが
アクセスの仕様を見ると
テーブル内のフィールド数の最大値は255なのですが
ADOXでＶＢＡでテーブルを作成してるのですが

実行時エラー　-2147217858
複数回フィールドを定義することは出来ません。
と言うエラーになり、テーブルが作れません。

ｖｂａコードの一部は

Set cat = New ADOX.Catalog
Set tbl = New ADOX.Table
cat.ActiveConnection = CurrentProject.Connection
tbl.Name = "test"

For i = LBound(tmp) To 200 ' UBound(tmp)
Col = tmp(i)

tbl.Columns.Append Col, adVarWChar, 20
tbl.Columns(Col).Attributes = adColNullable
Next i

cat.Tables.Append tbl

です。

ためしに
To 200　を　To 100
にしても同じようなエラーになりました。

何でエラーになるのでしょう？？？

回答No.2

piroin654 · ベストアンサー

No1です。
質問では、テーブルを新規に作成するということなので、
No1はそれぞれ、

Sub test133()
Dim cat As New ADOX.Catalog
Dim tbl As ADOX.Table
Dim col As New ADOX.Column
Dim i As Long

cat.ActiveConnection = CurrentProject.Connection
Set tbl = New ADOX.Table
tbl.Name = "テーブル名"

With tbl.Columns
For i = 1 To 10
.Append "F" & i, adVarWChar, 20
Next i
End With
cat.Tables.Append tbl

Set cat = Nothing
End Sub

Sub test134()
Dim cat As New ADOX.Catalog
Dim tbl As ADOX.Table
Dim col As New ADOX.Column
Dim i As Long

cat.ActiveConnection = CurrentProject.Connection
Set tbl = New ADOX.Table
tbl.Name = "テーブル名"
cat.Tables.Append tbl

For i = 1 To 10
Set col = New ADOX.Column
With col
.Name = "F" & i
.Type = adVarWChar
.DefinedSize = 20
.Attributes = adColNullable
End With
tbl.Columns.Append col
Set col = Nothing
Next i

Set cat = Nothing
End Sub

のように。「テーブル名」の新規テーブルにフィールド名を
F1,F2・・・のように新規に設定します。

お礼

どうもありがとうございました。

回答No.1

piroin654

フィールドを追加する方法を二つばかり。

二つのプロシージャで、
For i = 2 To 10
としているのは、あらかじめフィールドが
一つ設定してあって、フィールド名は"F1"
となっています。追加すると、F2,F3,F4・・・・
が追加されます。

一番目と二番目の違いがわかるでしょうか？
質問は二番目のほうだと思いますが。この方法では、
ループの中でColumn設定したり削除したりします。
ループに入る位置、フィールドの設定方法、オブジェクトの
設定と破棄などについて確認してみてください。

なお、質問の中のエラー、

実行時エラー　-2147217858
複数回フィールドを定義することは出来ません。
と言うエラーになり、テーブルが作れません。

は、コードを実行すると、そのときフィールドが一つだけ
設定されてふたたびループに入ったときに同じフィールドを
作成しようとしてエラーが起きるのでは、と思います。
エラーの原因はループの位置、オブジェクトの設定と破棄
などでしょう。
質問のコードを実行していないので推測ですが。

Sub test131()
Dim cat As New ADOX.Catalog
Dim tbl As ADOX.Table
Dim col As New ADOX.Column
Dim i As Long

cat.ActiveConnection = CurrentProject.Connection
Set tbl = cat.Tables("テーブル名")

With tbl.Columns
For i = 2 To 10
.Append "F" & i, adVarWChar, 20
Next i
End With

Set cat = Nothing
End Sub

Sub test132()
Dim cat As New ADOX.Catalog
Dim tbl As ADOX.Table
Dim col As New ADOX.Column
Dim i As Long

cat.ActiveConnection = CurrentProject.Connection
Set tbl = cat.Tables("テーブル名")

For i = 2 To 10
Set col = New ADOX.Column
With col
.Name = "F" & i
.Type = adVarWChar
.DefinedSize = 20
.Attributes = adColNullable
End With
tbl.Columns.Append col
Set col = Nothing
Next i

Set cat = Nothing
End Sub

お礼

どうもありがとうございました。