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
=====================================================================

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

宜しくお願い致します。

回答No.1

nicotinism · ベストアンサー

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

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

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

お礼

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