アクセス VBA サブフォルダからインポート
アクセス・エクセル2010を使用しています。
以下の作業を実行したいと考えていますが、初心者につき、ご教示ください！
1．ダイアログを表示させ、フォルダを指定したい：トップパス設定
2．1で指定したトップパス内（サブフォルダを含む）にある
一定のネーミングファイルを範囲を指定してインポート（マージ）したい
動作条件）
a．トップパス：D:\test ←ダイアログで指定したい（可能であれば・・次回の動作時に覚えさせておきたい）
b．インポートファイルの名称：*_3年目.xls（語尾に「_3年目」と付くエクセル） ←フォームのテキストボックスで設定したい
c．インポート範囲：B7:Z56 ←変動するので、フォームのテキストボックスで設定したい
現在、同じパス内にあるエクセルファイルを指定した範囲でテーブルにインポートする
というところまでは、ご親切な方にご教示いただき、以下にてうまく動いています。
初心者のため、どこをどう変更・設定すると
上記のような動きにできるのかがわかっておりませんため、
ご教示いただけないでしょうか。
※[frm]![txt_範囲]：範囲指定をするフォームのテキストボックス
仮テーブル：取り込み時に作成するマージ用テーブル
Dim f As Object
Dim b As Object
Dim c As Object
Dim d As Object
Dim t As Variant
Dim e As Object
Dim p As String
Dim i As Long
Dim sSql As String
Dim x As String
Set e = CreateObject("Excel.Application")
t = e.GetOpenFilename("Excel Files (*.xls*), *.xls*")
If t = False Then Exit Sub
x = Forms![frm]![txt_範囲]
Set f = CreateObject("Scripting.FileSystemObject")
p = f.GetParentFolderName(t)
Set d = f.GetFolder(p)
Set b = d.Files
On Error Resume Next
sSql = "DROP TABLE 仮テーブル "
CurrentProject.Connection.Execute CommandText:=sSql
sSql = "DROP TABLE 一時テーブル "
CurrentProject.Connection.Execute CommandText:=sSql
On Error GoTo 0
For Each c In b
If LCase(f.GetExtensionName(c)) Like "xls*" Then
If i = 0 Then
DoCmd.TransferSpreadsheet acImport, , "仮テーブル", c, True, x
sSql = "ALTER TABLE 仮テーブル ADD COLUMN ファイル名 VarChar(50);"
CurrentProject.Connection.Execute CommandText:=sSql
sSql = "UPDATE 仮テーブル SET ファイル名='" & f.GetFileName(c) & "';"
CurrentProject.Connection.Execute CommandText:=sSql
i = i + 1
Else
On Error Resume Next
sSql = "DROP TABLE 一時テーブル "
CurrentProject.Connection.Execute CommandText:=sSql
On Error GoTo 0
DoCmd.TransferSpreadsheet acImport, , "一時テーブル", c, True, x
sSql = "ALTER TABLE 一時テーブル ADD COLUMN ファイル名 VarChar(50);"
CurrentProject.Connection.Execute CommandText:=sSql
sSql = "UPDATE 一時テーブル SET ファイル名='" & f.GetFileName(c) & "';"
CurrentProject.Connection.Execute CommandText:=sSql
sSql = "INSERT INTO 仮テーブル SELECT * FROM 一時テーブル"
CurrentProject.Connection.Execute CommandText:=sSql
i = i + 1
End If
End If
Next
On Error Resume Next
sSql = "DROP TABLE 一時テーブル "
CurrentProject.Connection.Execute CommandText:=sSql
On Error GoTo 0
e.Quit
Set e = Nothing
MsgBox "データがインポートされました。"
End Sub
尚、せっかく教えていただいたコードではありますが、
上記コードを用いては思った動作にならないのであれば、
新しい手法で教えていただくんでも構いません。
是非、よろしくお願いします！！
