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

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

締切り済みの質問

Access VBA インポート シート指定

AccessのVBA を用いて、ExcelからAccessへデータを
インポートする際、ダイアログボックスを表示させて
Excelのファイルを選択させるようにしています。

これをシート名まで指定させる事は可能でしょうか?

◆シートは枚数が固定されず、都度かわります。
◆インポートしたいシート数も都度かわります。
◆1sheet = 1 テーブルにしたいです。
◆1度の動作で、1sheetのインポートでも、複数でもかまいません。
◆できれば、ダイアログでファイルを選択した流れで
シートまで選択される方法が望ましいです。
◆Accessのテーブル名もテキストボックスで任意なものが
付けられるようにしたいです。

お知恵をお貸し下さい、何卒よろしくお願いいたします。

投稿日時 - 2011-10-07 17:59:49

QNo.7057369

すぐに回答ほしいです

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

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

回答(2)

ANo.2

WIN 7 Home Premium Access2010の環境でテストをしました。

シート名格納用のテーブル“T_選択シート名”(シート名・テキスト型、選択・Yes/No型、テーブル名・テキスト型)、ファイル選択用のフォーム“F_ファイル選択”(コマンドボタンを2つ<選択、インポート>、テキストボックスを1つ<ファイル名>、サブフォームを1つ<F_選択シート名 T_選択シート名から生成>)を作成

Microsoft Office 14.0 Object Library及びMicrosoft ActiveX Data Objects 6.0の参照設定を行う。

1.フォーム上のコマンドボタン“ファイル選択”をクリック
2.ファイル選択ダイアログボックスを表示
3.処理するエクセルふぁいえうを選択
4.DAOで選択したエクセルファイルのシート名を取得 → Microsoft Access Clubの記事を参考
5.サブフォームにシート名を表示
6.処理するシートをサブフォーム城から選択
7.フォーム上のコマンドボタン“テーブルへインポート”をクリック
8.選択したシートをインポート
※フォームの画像を添付しましたが、見ずらかったらすみません。

Private Sub 選択_Click()
Dim FDB As FileDialog
Set FDB = Application.FileDialog(msoFileDialogFilePicker)
Dim SFL As Variant
Dim FileSelect As Variant

With FDB
.Title = "Excelファイルの選択"
.Filters.Add "Excelファイル", "*.xls; *.xlsx; *.xlsm", 1
.Filters.Add "すべてのファイル", "*.*"
.AllowMultiSelect = False
.InitialFileName = CurrentProject.Path

If .Show = -1 Then
For Each SFL In .SelectedItems
FileSelect = SFL
Next
End If
End With

Me!L_ファイル名.Visible = True: Me!ファイル名.Visible = True
Me!ファイル名 = FileSelect

DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE T_選択シート名.* FROM T_選択シート名;"
DoCmd.SetWarnings True

Dim RS As New ADODB.Recordset
Dim CN As New ADODB.Connection
Set CN = CurrentProject.Connection
RS.Open "T_選択シート名", CN, adOpenKeyset, adLockOptimistic


Dim Db As DAO.Database
Dim Tbl As DAO.TableDef
Dim xlsFile As String

xlsFile = FileSelect
Set Db = OpenDatabase(xlsFile, True, True, "Excel 12.0;")

For Each Tbl In Db.TableDefs
If Right$(Tbl.Name, 1) = "$" Or Right$(Tbl.Name, 2) = "$'" Then
'シート名の最後は必ず$が付きます
RS.AddNew
RS.Fields(0).Value = Left(Tbl.Name, (Len(Tbl.Name) - 1))
RS.Update
End If
Next Tbl
RS.Close: Set RS = Nothing
CN.Close: Set CN = Nothing

Db.Close
Set Db = Nothing

Set FDB = Nothing

Me!F_選択シート名.Visible = True
Me!F_選択シート名.Requery
Me!インポート.Visible = True

End Sub

Private Sub インポート_Click()
Dim I As Integer
Dim RS As New ADODB.Recordset
Dim CN As New ADODB.Connection
Set CN = CurrentProject.Connection

RS.Open "T_選択シート名", CN, adOpenKeyset, adLockOptimistic

For I = 1 To RS.RecordCount
If RS.Fields(1).Value = True Then
DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel12, RS.Fields(2).Value, Me!ファイル名, True, RS.Fields(0).Value & "!"
End If
RS.MoveNext
Next I

RS.Close: Set RS = Nothing
CN.Close: Set CN = Nothing

End Sub

参考URL:http://www.accessclub.jp/bbs5/0005/vba1231.html

投稿日時 - 2011-10-09 20:59:30

ANo.1

数日前に同様のエクセルからアクセスへVBAでインポートする質問の回答のとき書いたのだが、
oCmd.TransferSpreadsheet acImport
を使う限りでは,シートは個別に指定しなければならず、1シート1回ずつの実行になると思う。
出来ることは、これをVBAで繰り回すプログラムを作ることだけではないかな。
(エクセルVBAでシートをよみ、ADOなどでアクセスのテーブルにレコードを書き込んでいく方法はあるが、本回答はそれは目指してない)
・ファイル指定
>「ダイアログボックスを表示させてExcelのファイル(X)を選択させるようにしています、であればその点は解決済みと思うので
・シート指定
あとはシート名を何かに表示させて、シートを1つ選択させて(Y)、両者からDocmdの文字列にX,Yを組み込めば仕舞いでしょう。
ーー
例 全般的に見て主要なテーマは
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "01化", "01化.xls", True, "Sheet1!A1:D3"
ーー
2つのことがしたいのだと思う
(1)(アクセスにインポートしたい)エクセルファイル(ブック)を1つ指定
沢山のブックを一遍に指定していくようなのは、さらに難しくなると思うので除外
(2)そのファイルの中のシートを1つ指定
こちらは複数同時指定は出来ない模様。
これらを出来れば対話形式(ダイアロウグ)で選択したいということかな。
ーーー
しかし、結構下記は難物であるようだ。
(1)アクセスではファイル選択のダイアロウグは(APIを使わないと出来ない、APIの使用はVBAを外れる。
WEBには例が載っているが)使えないようだ。
質問者は出来ているような口ぶりだが、この部分はどのようにしたのかな。
(2)シート選択のダイアロウグが(これはもちろんエクセルVBAの世界でだが)が良いものが無い。
これもWEBに回答として上がっている例があるが、難しいので使用を避けた。PopUpなどの例があるが、簡単ではない。
それでInputBoxのコメントにシート名をだし、その中の番号を入力するで逃げた。
それで、エクセルとアクセスを行き来する、すっきりしないものになっているが一応私の試行例を挙げておく。
改良してください。
ーーー
Access(エクセルではない)のモジュールに
Sub Sample4()
Dim sn(30)
Dim ws As Object
Dim xlsFileName As String
Set xls = CreateObject("Excel.Application")
xlsFileName = xls.GetOpenFilename("Microsoft Excelブック,*.xls")
If xlsFileName <> "False" Then
fn = Split(xlsFileName, "\")
fns = fn(UBound(fn)) 'ファイル名の部分を摘出
MsgBox fns
Else
MsgBox "キャンセルされました"
End If
'--
Set bk = xls.workbooks.Open(xlsFileName)
'----シート選択
i = 1
For Each ws In bk.Worksheets
sn(i) = ws.name
s = s & i & " " & ws.name & vbCr
i = i + 1
Next
X = InputBox(s, "シート選択 番号指定")
MsgBox sn(X) & " を選択しました"
sns = sn(X)
'--
bk.Close
xls.Quit
Set xls = Nothing
'-----エクセルは脱出してアクセスで実行
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "01化", fns, True, sns & "!A1:D4"
End Sub
この例では1シートのコードなので、まず1例でテストして出来るかどうか納得してください。
その後、「多数または同一のブック」の他シートについて連続してやる場合は、上記のコード全体をループの中において、
DoCmd.のテーブル名の01化  に当たるアクセスの(エクセルの1シートに対応する)テーブル名を都度使用者から、変数に受け取るようなコードに変えて、(最低ではInputBoxで聞いて、応答を受ける)、その変数で、テーブル名をセットするに変えてください。
各シートのデータ範囲は最大の範囲を指定して、うまく行かないかやってみてください。(毎回範囲を指定するとなるとさらに複雑になる。エクセル側で、Application.Inputboxのタイプ8利用など。)

投稿日時 - 2011-10-09 11:12:23

あなたにオススメの質問