アクセス2007 テーブルの全削除とデータ移動

質問

アクセス2007　テーブルの全削除とデータ移動

全テーブルを削除して、データをインポートしようとしています。

質問1.
下記のコードで、リレーションの張ってあるテーブルの削除でエラーになります。
でも、DoCmd.SetWarnings Falseの状態で、手動で削除するとエラーになりません。
だったらと思い、コードにDoCmd.SetWarnings Falseを追加したのですが、やはりエラーになります。
対処法はないでしょうか？

質問2.
テーブルの中に「~TMP******」という勝手に作られたテーブルは、削除してもいいものなのでしょうか？

質問3.
削除後にインポートをしたいのですが。
手動でアクセスメニュー＞外部データ＞アクセス（のインポート）＞現在の～～＞すべて選択（テーブル）＞ＯＫ
これを実現するＶＢの記述は、どんなコードになるのでしょうか？

---------------------------------------------------------------------
Private Sub 旧バージョンからデータ移動_Click()

Dim i As Integer
Dim tbls As DAO.TableDefs
Dim tbl As DAO.TableDef

'開いているフォーム全てを閉じる
For i = Forms.Count - 1 To 0 Step -1
DoCmd.Close acForm, Forms(i).Name
Next i

Set tbls = CurrentDb.TableDefs
DoCmd.SetWarnings False　 '追加-------------------　
　　’全テーブル削除
For Each tbl In tbls
If InStr(1, tbl.Name, "MSys", vbBinaryCompare) = 0 And InStr(1, tbl.Name, "~TMP", vbBinaryCompare) = 0 Then
tbls.Delete (tbl.Name)
End If
Next

DoCmd.SetWarnings True　　　'追加----------------

　　’旧バージョンからのデータインポート
　　’ＶＢコードがわかりません

End Sub
-------------------------------------------------------------------------
※旧バージョンとはアクセス本体ではなく、自分でつくったＤＢの旧バージョンです。
複数質問で申し訳ありませんが、よろしくお願い致します。

回答No.2

piroin654 · ベストアンサー

失礼しました。リレーションのことを
見逃していました。

'テーブルの削除
Private Sub コマンド0_Click()

Dim db As Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim rels As Relations

strSQL = "SELECT [Name] " & _
"FROM MSysObjects " & _
"WHERE ([Name] Not Like 'MSys*') AND ([Type]=1)"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
Set rels = db.Relations

Do While rels.Count > 0
Debug.Print rels(0).Name
rels.Delete rels(0).Name
Loop

rs.MoveFirst
Do Until rs.EOF
db.Execute "DROP TABLE " & rs!Name
rs.MoveNext
Loop

rs.Close
Set rs = Nothing
db.Close
Set db = Nothing

End Sub

補足

無事、データ移動することができました。
私程度の技量ではとても無理なコードで大変助かりました。

今後、このご回答を参考される私のような初心者の方の為に。
・最初に全てのフォームを閉じておく
・テーブル削除（私の場合「~TMP******」を削除しても大丈夫でした）
・テキストボックスtxパスの代わりに、旧バージョンの場所を指定できる「ファイル選択ウインド」の利用。
・アクセス2007の場合、旧バージョンの場所が「信頼できる場所」にあること。でないと、テーブル数の分だけ「確認」がくる。
ということで、宜しいでしょか？

回答No.5

piroin654

すみません。何だか勘違いな一文が
入り込んでいました。

>InputBoxに関しては、数値の
>入力にたいして文字をいれたり、空で
>OKを押したりなどのエラー処理を
>入れていなかったのが気になるところですが、
>いずれInputBoxを使用するような場合には
>また質問してみてください。

他の分野で出す予定だった回答の一部を
間違ってコピーして張り付けてしまいました。
自分ながら・・・・という感じです。
この一文はスルーしてください。

回答No.4

piroin654

プログラムが役に立てて安心しました。

>・最初に全てのフォームを閉じておく
>・テーブル削除（私の場合「~TMP******」を削除しても大丈夫でした）
>・テキストボックスtxパスの代わりに、旧バージョンの場所を指定できる「ファイル選択ウインド」の利用。

>・アクセス2007の場合、旧バージョンの場所が「信頼できる場所」にあること。でないと、テーブル数の分だけ「確認」がくる。

以上の件確認しました。いいと思います。
InputBoxに関しては、数値の
入力にたいして文字をいれたり、空で
OKを押したりなどのエラー処理を
入れていなかったのが気になるところですが、
いずれInputBoxを使用するような場合には
また質問してみてください。

ファイル選択ウィンドウでパスが完全に
取得できることを確認してくださいね。

Access2007はセキュリティが厳しいので
「場所」の問題はある程度経験すれば
いろいろな対処法を見つけられます。

ごくろうさまでした。

お礼

ありがとうございました。
感謝致します。

回答No.3

piroin654

訂正です。

Do While rels.Count > 0
Debug.Print rels(0).Name
rels.Delete rels(0).Name
Loop

の

Debug.Print rels(0).Name

を削除してください。

回答No.1

piroin654

削除確認後、インポートするのがいいのでは。
ということで、ボタンを二つのコードです。
一応、質問の順序で回答します。

(1)テーブルをすべて削除するサンプル

Private Sub コマンド0_Click()

Dim db As Database
Dim rs As DAO.Recordset
Dim strSQL As String

strSQL = "SELECT [Name] " & _
"FROM MSysObjects " & _
"WHERE ([Name] Not Like 'MSys*') AND ([Type]=1)"
Set db = CurrentDb

Set rs = db.OpenRecordset(strSQL, dbOpenForwardOnly)
Do Until rs.EOF
db.Execute "DROP TABLE " & rs!Name
rs.MoveNext
Loop

rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub

(2)
http://support.microsoft.com/default.aspx?scid=kb;ja;90129
http://support.microsoft.com/default.aspx?scid=kb;ja;209803
このあたりに何かしらの説明がありますが、本来は削除
される予定のもので、何らかの理由で残ったのでしょう。
Accessを終了したり、最適化すればなくなると思います。
それでも無くならないのならば、ファイルを別にコピーして
その「~TMP******」を削除して様子をみてください。

(3)
テーブルをインポートするサンプル(msのsupportの改造)
フォームにテキストボックスtxパスを設置。
txパスに取り出すテーブルがあるmdbのパス
を表示した方法。あとは適当にアレンジ。
コピーするときは長い一文があるので、
張り付けたときにエラーにならないように。

'テーブルのインポート
Private Sub コマンド1_Click()
Dim db As Database
Dim td As TableDef
Dim strTDef As String
Dim strPATH As String
Dim cdb As Database

strPATH = Me!txパス
Set db = DBEngine.Workspaces(0).OpenDatabase(strPATH, True)

For Each td In db.TableDefs
strTDef = td.Name
If Left(strTDef, 4) <> "MSys" Then
DoCmd.TransferDatabase acImport, "Microsoft Access", strPATH, acTable, strTDef, strTDef, False
End If
Next

Set cdb = Nothing
Set td = Nothing
db.Close
Set db = Nothing
End Sub

補足

詳細なご教示ありがとうございます。
削除する所ですが、やはりリレーションの張ってあるテーブルでエラーが出ます。
今日はもう遅いので、明日また確認したいと思います。