|
自己レスです。解決しました。お騒がせしました。
以下、私のコードです。これで通りました。DAOとADOが混ざってしまっていますが、動くのでよしとしてください。
参考にしたURL:
(a) office.microsoft.com/ja-jp/access/HA012263061041.aspx
(b) msdn.microsoft.com/ja-jp/library/cc379080.aspx
--------------------------------
Sub EveryTableToPostgreSQL()
'インポート先のPostgresデータベースを定義。この文字列の取り方は下記(*1)参照。
Const ODBC_Str As String = "ODBC;DSN=PostgreSQL30;DATABASE=KAISHA_TEST;SERVER=localhost;PORT=5432;"
'変数・定数の定義
Dim db As DAO.Database 'データベース
Dim rst As DAO.Recordset 'レコードセット
Dim TransTables As TableDef 'テーブルオブジェクト
Dim tmpTbName As String 'テーブル名
Dim RecCount As Long 'レコード数
Const RecMAX As Long = 100000 'エクスポートするかどうかの基準にするレコード数(*2)
Dim omitTables() As String 'エクスポートしなかったテーブル名
Dim omitCount As Integer 'エクスポートしなかったテーブルの数
'エラー分岐
On Error GoTo AlreadyExist:
'DBセット、変数初期化
Set db = CurrentDb
omitCount = -1
'すべてのテーブルに対して処理
For Each TransTables In db.TableDefs
tmpTbName = TransTables.Name
If Left(tmpTbName, 4) <> "MSys" Then '下記(*3)参照
'レコード数を取得
Set rst = db.OpenRecordset(tmpTbName, dbOpenTable)
RecCount = rst.RecordCount
rst.Close
'レコード数が基準未満ならエクスポート実行、以上なら配列に格納
If RecCount < RecMAX Then
DoCmd.TransferDatabase acExport, "ODBC データベース", ODBC_Str, acTable, tmpTbName, tmpTbName, False, False
Else
omitCount = omitCount + 1
ReDim Preserve omitTables(omitCount) As String
omitTables(omitCount) = tmpTbName
End If
End If
Next
'DB閉じる、エクスポートしなかったテーブル名を表示
db.Close
MsgBox Join(omitTables, ",")
Exit Sub
'エラー処理
AlreadyExist:
'変数定義
Dim myDB As ADODB.Connection
'同じ名前のテーブルがエクスポート先に既にある場合、いったん削除して元のコードに戻る(*4)
If Err.Number = 3146 Then
Set myDB = New ADODB.Connection
With myDB
.Open "Provider=PostgreSQL;Data Source=localhost;location=KAISHA_TEST", "postgres", "postgres"
.Execute "DROP TABLE " & tmpTbName & ";", pgreturn
.Close
End With
Resume 0
Else
MsgBox Err.Number & Chr(13) & Err.Description
Exit Sub
End If
End Sub
--------------------------------
(*1)参考URL(a)参照。一度エクスポート先のテーブルにリンクを張り、そのテーブルをデザインモードで開いて、プロパティシートの「説明」の項目に入っている文字列です。テーブルの情報も入っているので、関係なさそうなものは削除する。
(*2)私の環境では15万レコードだと時間かかりすぎ、20万レコード超のテーブルがあるとPostgre側が落ちました。環境に応じて適宜設定してください。
(*3)よくわかりませんが、この文字列で始まるものがテーブルオブジェクトとして認識されるようだったので除くようにしてあります。
(*4)参考URL(a)には上書きされると書いてありますが、実際はエラーを発生したので、いったん削除するようにしました。
以上です。
|
|