yoshifuku回答ポイント 60ptウォッチ 2

Microsoft Access 2002を使っています。

今、拡張子mdbのファイルが200あります。各ファイルの中にはテーブルが14あります。
これらテーブルを全てExcelでエクスポートしたいのですが、手作業では大変です。
（全部で200×14＝2800回やらなければならない）

簡単にやりきる方法がありましたら、ご教授願います。
便利なフリーソフトがありましたら、その方法でも構いません。
どうぞよろしくお願い致します。

• はてなアカウントでログイン
• 無料ユーザー登録

ベストアンサー

• jccrh12009/04/13 17:44:35

  満足60pt

  エクセルからMDBをインポートした方が早いかも知れません。

  　

  以下の手順で作成してください。

  1.下記のEXCEL マクロ(VBA)を作成してください。

  　参照設定は「Microsoft Scripting Runtime」「Microsoft ActiveX Data ObjectS 2.8 Library」です。

  　※ActiveX Data ObjectS 2.8　は2.6等でも大丈夫だと思います。

  　　

  2.作成後このブックに名前を付けて（例えばインポート）保存してください。

  3.保存したブックと同じところにインポートしたいMDBをコピーしてください。

  4.インポート処理を（ツール→マクロ→「インポート.XLS」）実行してください。

  　

  注意）

  1.MDBごとにブックが作成されます。

  2.各テーブルはシートに作成されます。

  3.項目内容は全て文字でインポートしています。

  4.ブックを保存する時、すでに同じブック名がある時、メッセージが表示されます。

  　※再処理する時は、XLSをすべて削除（インポート.XLS以外）すれば良いと思います。

  5.変数宣言は省略しています。

  　

  　

  Sub インポート()

  　Dim CN As ADODB.Connection

  　Dim SC As ADODB.Recordset

  　Dim RS As ADODB.Recordset

  　Set CN = New ADODB.Connection

  　Set RS = New ADODB.Recordset

  　

  　CN.Provider = "Microsoft.Jet.OLEDB.4.0"

  　With Application.FileSearch

  　　.NewSearch

  　　.SearchSubFolders = True

  　　.LookIn = ThisWorkbook.Path

  　　.Filename = "*.MDB"

  　　.Execute

  　　For MDB_NO = 1 To .FoundFiles.Count

  　　　CN.Open .FoundFiles(MDB_NO)

  　　　Workbooks.Add

  　　　Set rstSC = CN.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "Table"))

  　　　Do While Not (rstSC.EOF)

  　　　　Worksheets.Add

  　　　　ActiveSheet.Name = rstSC!TABLE_NAME

  　　　　SQL = "SELECT * FROM [" & rstSC!TABLE_NAME & "]"

  　　　　RS.Open SQL, CN, adOpenStatic, adLockReadOnly

  　　　　For ColNo = 1 To RS.Fields.Count

  　　　　　Cells(1, ColNo) = RS.Fields(ColNo - 1).Name

  　　　　Next ColNo

  　　　　RowNo = 2

  　　　　Do While Not (RS.EOF)

  　　　　　For ColNo = 1 To RS.Fields.Count

  　　　　　　Cells(RowNo, ColNo) = "'" & RS.Fields(ColNo - 1).Value

  　　　　　Next ColNo

  　　　　　RowNo = RowNo + 1

  　　　　　RS.MoveNext

  　　　　Loop

  　　　　Cells.EntireColumn.AutoFit

  　　　　RS.Close

  　　　　rstSC.MoveNext

  　　　Loop

  　　　ActiveWorkbook.SaveAs (.FoundFiles(MDB_NO) & ".XLS")

  　　　ActiveWorkbook.Close

  　　　CN.Close

  　　Next MDB_NO

  　End With

  End Sub

  スター

  • yoshifuku 2009/04/14 13:41:51

    完璧にできました。素晴らしいです。

    本当に助かりました！！

    いるか贈ります！！

その他の回答

この質問へのコメント

質問の情報

登録日時

2009-04-13 12:00:03

終了日時

2009-04-14 13:42:02

回答条件

1人1回まで

この質問のカテゴリ

• コンピュータ

この質問に含まれるキーワード

人気の質問

• １０年前に購入した３万円のPCが遂に壊れました。 長持ちした方でしょうか？ …coccinellab212日前
• 買取アプリ「cashari」についてです cashariでリースバックした商品（ゲーム等）を仮にリース期間中に売る…匿名質問者1111日前
• 今2023年ですがこの今の日本の条件下で少子高齢化を解決するとしたら何か良い案がありますか?政策を実施す…寺本まこと2211日前
• ホルモンですが、効果を発揮した後は、別のものに変化してしまうんでしょうか。セロトニンは心を落ち着かせ…匿名質問者10時間前
• iPhoneを適当なキャリアで複数契約させた後SIMカードを抜き、本体のみ業者に送り買取といった内容の資金調…匿名質問者112時間前

メニュー

• 質問一覧
• カテゴリ一覧
• 無料ユーザー登録
• 人力検索はてなトップ

PC版

• お問い合わせ
• ヘルプ
• お知らせ
• はてなトップ