アクセス2000のデータベースにテーブルを追加して、フィールドを作成したい

アクセス2000のデータベースがあります。
このファイル「c:\ynet\Hz2data1.mdb」に新しいテーブル「会費管理2」を追加して、フィールドを作成したいのです。
現在は「会費管理2」テーブルがあるのを前提に下記のように書き込みしてみましたが・・・
新しく「会費管理2」テーブルを指定したファイル「c:\ynet\Hz2data1.mdb」に作成してフィールドも作成するのを同時にできるのかしら？
どなたか助けていただければ幸いです。
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　かしこ



Private Sub コマンド1_Click()
Beep
If (MsgBox("データをアップデートしますが宜しいですか？　作業は一瞬で終わりますよ！！") = 7) Then
End If
Dim cnn As ADODB.Connection
Dim catDB As ADOX.Catalog
Dim tbl As ADOX.Table
Dim colAdo As ADOX.Column
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;"
strCon = strCon & "Data Source=c:\ynet\Hz2data1.mdb"
Set cnn = CurrentProject.Connection
Set catDB = New ADOX.Catalog
catDB.ActiveConnection = cnn
Set tbl = New ADOX.Table
tbl.Name = "会費管理2"


'以下追加したいフィールド
Set colAdo = New ADOX.Column
With colAdo
.Name = "個別台帳ID"
.Type = adInteger
.Attributes = adColNullable
End With
tbl.Columns.Append colAdo
Set colAdo = New ADOX.Column
With colAdo
.Name = "会費名称ID"
.Type = adInteger
.Attributes = adColNullable
End With
tbl.Columns.Append colAdo
Set colAdo = New ADOX.Column
With colAdo
.Name = "会費区分ID"
.Type = adInteger
.Attributes = adColNullable
End With
tbl.Columns.Append colAdo
Set colAdo = New ADOX.Column
With colAdo
.Name = "年度"
.Type = adInteger
.Attributes = adColNullable
End With
tbl.Columns.Append colAdo
Set colAdo = New ADOX.Column
With colAdo
.Name = "入金日"
.Type = adDate
.Attributes = adColNullable
End With
tbl.Columns.Append colAdo
Set colAdo = New ADOX.Column
With colAdo
.Name = "入金額"
.Type = adCurrency
.Attributes = adColNullable
End With
tbl.Columns.Append colAdo
Set colAdo = Nothing
Set tbl = Nothing
Set catDB = Nothing
cnn.Close
End Sub

No.2 ベストアンサー 回答者： 30246kiku 回答日時： 2010/01/19 16:44

動作確認してみましたので、その内容が参考になればと。

不要であれば、スルーしてください。


事前準備）
・新規 mdb を C:\ynet\test_ynet.mdb として作っておきます。（中身何もなし）
・VBAを記述実行する mdb を新規作成します。
　VBEの画面で標準モジュールを挿入し、以下を記述します。
　FILENAME には、テーブルを作成する mdb のパスを、
　TABLENAME には、作成するテーブル名を記述しておきます。

　ADOBD / ADOX が使えるように、参照設定で設定しておきます。

　実行するのは Sample1 で作成しておいて、Sample2 で追加していくものになります。
（Sample1/2 の違いは★部分だけなので、実際の実行順は関係ないのですけど）

対象の mdb にテーブルが存在しなかったら作成し、あったら追加。
フィールドを重複して追加しようとした時のエラーは、無視して処理を続けるものになります。

Sample1の実行は、Sample1内をクリック後、「F5」キーで、
同様に Sample2 の実行は、Sample2内をクリック後、「F5」キーで行います。

確認は、Sample1実行後、対象ファイルを開いて確認します。
同様に、Sample2実行後、対象ファイルを開いて確認します。

------　標準モジュールに記述する内容は以下

Const FILENAME = "C:\ynet\test_ynet.mdb"
Const TABLENAME = "会費管理2"

Private Sub SetCol(tbl As ADOX.Table, sName As String, iType As Long)
　　Dim colAdo As ADOX.Column

　　On Error Resume Next
　　Set colAdo = New ADOX.Column
　　With colAdo
　　　　.Name = sName
　　　　.Type = iType
　　　　.Attributes = adColNullable
　　End With
　　tbl.Columns.Append colAdo
　　Set colAdo = Nothing
End Sub

Private Sub Sample1()
　　Dim cnn As ADODB.Connection
　　Dim catDB As ADOX.Catalog
　　Dim tbl As ADOX.Table
　　Dim sProvider As String
　　Dim bNew As Boolean

　　sProvider = CurrentProject.Connection.Provider
　　Set cnn = New ADODB.Connection
　　cnn.Open "Provider=" & sProvider & "; DATA Source='" & FILENAME & "'"
　　Set catDB = New ADOX.Catalog
　　catDB.ActiveConnection = cnn

　　On Error Resume Next
　　bNew = False
　　Set tbl = catDB.Tables(TABLENAME)
　　If (tbl Is Nothing) Then
　　　　Set tbl = New ADOX.Table
　　　　tbl.Name = TABLENAME
　　　　bNew = True
　　End If

　　Call SetCol(tbl, "数値1", adInteger)
　　Call SetCol(tbl, "数値2", adInteger)
　　Call SetCol(tbl, "数値3", adInteger)
　　Call SetCol(tbl, "日付", adDate)
　　Call SetCol(tbl, "金額", adCurrency)

　　If (bNew = True) Then
　　　　catDB.Tables.Append tbl
　　End If

　　catDB.Tables.Refresh

　　Set tbl = Nothing
　　Set catDB = Nothing
　　Set cnn = Nothing
End Sub

Private Sub Sample2()
　　Dim cnn As ADODB.Connection
　　Dim catDB As ADOX.Catalog
　　Dim tbl As ADOX.Table
　　Dim sProvider As String
　　Dim bNew As Boolean

　　sProvider = CurrentProject.Connection.Provider
　　Set cnn = New ADODB.Connection
　　cnn.Open "Provider=" & sProvider & "; DATA Source='" & FILENAME & "'"
　　Set catDB = New ADOX.Catalog
　　catDB.ActiveConnection = cnn

　　On Error Resume Next
　　bNew = False
　　Set tbl = catDB.Tables(TABLENAME)
　　If (tbl Is Nothing) Then
　　　　Set tbl = New ADOX.Table
　　　　tbl.Name = TABLENAME
　　　　bNew = True
　　End If

　　Call SetCol(tbl, "数値1", adInteger)
　　Call SetCol(tbl, "数値2", adInteger)
　　Call SetCol(tbl, "数値3", adInteger)
　　Call SetCol(tbl, "日付", adDate)
　　Call SetCol(tbl, "金額", adCurrency)

　　Call SetCol(tbl, "個別台帳ID", adInteger) ' ★
　　Call SetCol(tbl, "会費名称ID", adInteger) ' ★
　　Call SetCol(tbl, "会費区分ID", adInteger) ' ★
　　Call SetCol(tbl, "年度", adInteger) ' ★
　　Call SetCol(tbl, "入金日", adDate) ' ★
　　Call SetCol(tbl, "入金額", adCurrency) ' ★

　　If (bNew = True) Then
　　　　catDB.Tables.Append tbl
　　End If

　　catDB.Tables.Refresh

　　Set tbl = Nothing
　　Set catDB = Nothing
　　Set cnn = Nothing
End Sub


※
Access に記述するVBAということで、Provider に指定する文字列は、
CurrentProject.Connection.Provider
から拾ってきています。

2007で実行したとして、対象ファイルを xxxx.accdb に変更した時でも動作します。
Provider=Microsoft.Jet.OLEDB.4.0;
に固定すると、2007で実行したとしても mdb に限定されます。
（余計なことになりますが）

※
データが空の時に確認した内容になるので、それ以外は確認してください。

この回答へのお礼

ご親切丁寧なアドバイスありがとう御座いました。
完璧にできました。感激しちゃいました！！
途中までやった私のやり方は間違ってたのかしら・・・？
本当にありがとう御座いました。

お礼日時：2010/01/20 12:55

No.1 回答者： 30246kiku 回答日時： 2010/01/18 18:35

勉強不足の私ですが、おかしかったらスルーしてください。

「会費管理2」が既にあるのなら、

strCon = "Provider=Microsoft.Jet.OLEDB.4.0;"
strCon = strCon & "Data Source=c:\ynet\Hz2data1.mdb"
Set cnn = CurrentProject.Connection
Set catDB = New ADOX.Catalog
catDB.ActiveConnection = cnn
Set tbl = New ADOX.Table
tbl.Name = "会費管理2"

は、前回補足に書かれていた内容

strCon = "Provider=Microsoft.Jet.OLEDB.4.0;"
strCon = strCon & "Data Source=c:\ynet\Hz2data1.mdb"
Set cnn = New ADODB.Connection
cnn.Open strCon
Set catDB = New ADOX.Catalog
catDB.ActiveConnection = cnn
Set tbl = catDB.Tables("会費管理2")

で良いと思います。
（変数宣言で New 指定が無い時の記述になりますが）
（前回の補足では New 指定されていましたが、今回は違うのですね）