みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excel複数シートをaccessへ一括インポート

Excel複数シートを、accessへ1つのテーブルへ一括インポート
(1) ワークブックは複数あります。
(2) ブックには、色々な名前のシート名があります。
(3) テーブルに指定する名前をワークブックに合わせればと思ってます

複数シートの一括取り込みの vb は以下の通り作ってみました。
ここでは、 vbの中で「テーブル名」・「ドライブ内のワークブック(xlsデータ)」指定しなければいけないので、
任意で「テーブル名」・「ワークブック(xlsデータ)」「ドライブ」を(ダイアログボックスなど)指定出来ればと思っています。

=====================================================================
Private Sub コマンド0_Click()

'//////////////////////////////////////////////////////////
'/Excel複数シートのAccessテーブルへのインポート /
'/参照設定 Microsoft Excel x.x Object Library /
'//////////////////////////////////////////////////////////

Const csWsRng As String = "A1:D1000"
Const csTblName As String = "インポートテーブル"
Const csWbPath As String = "D:\"
Dim voXlApp As Excel.Application
Dim voXlWb As Excel.Workbook
Dim voXlWs As Excel.Worksheet

Set voXlApp = New Excel.Application
voXlApp.Visible = True
Set voXlWb = voXlApp.Workbooks.Open(FileName:=csWbPath & "\aaaa.xlsx", _
ReadOnly:=True)

For Each voXlWs In voXlWb.Worksheets
DoCmd.TransferSpreadsheet TransferType:=acImport, _
SpreadsheetType:=acSpreadsheetTypeExcel9, _
TableName:=csTblName, _
FileName:=voXlWb.FullName, _
HasFieldNames:=True, _
Range:=voXlWs.Name & "!" & csWsRng
Next voXlWs

voXlWb.Close
voXlApp.Quit
Set voXlWs = Nothing
Set voXlWb = Nothing
Set voXlApp = Nothing

End Sub
=====================================================================

ご教示頂ければと思います。

宜しくお願い致します。

投稿日時 - 2012-03-24 15:03:21

QNo.7381087

困ってます

質問者が選んだベストアンサー

ファイル選択なら、FileDialog を使うとかして
http://www.geocities.jp/cbc_vbnet/tips/dialog.html
上記サンプルコード中の変数名を使うとして
(FileName:=csWbPath & "\aaaa.xlsx" を
(FileName:=vrtSelectedItem

テーブル名はご自身でも
TableName:=csTblName
とされているので、テーブル名の重複が起きない保証があればこのままで
でなければ、
Book名も付け足すとか(Book名_シート名)すれば良いのかな?

任意のテーブル名にしたいならば、
一旦テーブル(Bookフルパス|テーブル名)にでもBookフルパスを書き出して
テーブルを開いてテーブル名を手入力し、そのテーブルのレコードセットを廻して
インポート処理と絡めればよいのでは?

投稿日時 - 2012-03-25 23:04:19

お礼

返信遅くなり申し訳ありませんでした。 早速ご教示頂きました方法を行ってみましたところ、無事思い通りのものが、完成しました。 ありがとうございました!

投稿日時 - 2012-04-08 23:18:29

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

あなたにオススメの質問