ACCESS VBA CSVのインポート ファイル名指定→ファイル名選択

現在、テキストボックスにファイル名を入れるとCSVファイルがインポートされ、テキストボックスに入れたファイル名からACCESSのテーブルにFileNameの項目の追加、書き込み等ができるプログラムを作りました。

ですが、このプログラムを根本的に修正してほしいとの事で、困ってます。
テキストボックスにファイル名を入れるのではなく、指定のフォルダからファイル名を複数選択し、まとめてインポートしたいという事でした。
この場合だと、プログラム自体がまったく変わりますよね？
FileNameの追加等は不可能ではないでしょうか？

現在のプログラムを記載しますので、どこを修正すればいいかアドバイスお願いします。



Private Sub Cmd_01_Click()

Dim ercd As Integer
Dim LsName As String
Dim TName As String
Dim ITName As String
Dim Name1 As String
Dim Name2 As String
Dim teigi As String
Dim SQL As String
Dim aa As Long
Dim mySQL As String
Dim db As Database


If Nz(Me.txt_01) = "" Then
MsgBox "インポートするファイル名を入力して下さい", vbOKOnly, "エラー"
Me.txt_01.SetFocus
Exit Sub
End If

'ファイル名の取得
strError = 0
LsName = "\\St1\第２業務部\$運用\1010030 アールジービー\業務\RGB一時作業ファイル\なるには不備チェック\TESTkanno\"
TName = Me.txt_01
LsName = LsName & TName & ".csv"
ITName = "T_Mas"


'インポートの確認
ret = MsgBox(TName & "をインポートしますか？", vbYesNo + vbQuestion, "インポート確認")

If ret = vbNo Then
Exit Sub
End If
Debug.Print LsName



'レコードの追加
teigi = "ＲＧＢ定義"
DoCmd.TransferText acImportDelim, teigi, ITName, LsName, True

ret = MsgBox(TName & "をマスターに追加しますか？", vbYesNo + vbQuestion, "インポート確認")

If ret = vbNo Then
Exit Sub
End If



SQL = "INSERT INTO T_Mas (ID1,ID,処理状況,請求日,学校識別コード,学校名,学校分類名,メールアドレス,名前,ふりがな,性別,生年月日,職業,高校所在地,高校名,学年,郵便番号,都道府県,区市町村＆町域,番地以下,電話番号,FileName,区分,不備,不備理由,yu,gid,保留,処理済,件数報告日,納品日 )" & _
" SELECT [" & TName & "].[ID1], [" & TName & "].[ID],[" & TName & "].[処理状況], [" & TName & "].[請求日]," & _
" [" & TName & "].[学校識別コード], [" & TName & "].[学校名], [" & TName & "].[学校分類名], [" & TName & "].[メールアドレス]," & _
" [" & TName & "].[名前], [" & TName & "].[ふりがな], [" & TName & "].[性別], [" & TName & "].[生年月日]," & _
" [" & TName & "].[職業], [" & TName & "].[高校所在地], [" & TName & "].[高校名], [" & TName & "].[学年]," & _
" [" & TName & "].[郵便番号], [" & TName & "].[都道府県], [" & TName & "].[区市町村＆町域], [" & TName & "].[番地以下]," & _
" [" & TName & "].[電話番号], [" & TName & "].[FileName], [" & TName & "].[区分], [" & TName & "].[不備], [" & TName & "].[不備理由], [" & TName & "].[yu], [" & TName & "].[gid]," & _
" [" & TName & "].[保留], [" & TName & "].[処理済], [" & TName & "].[件数報告日],[" & TName & "].[納品日], From" & "LsName"


Debug.Print SQL


Name1 = TName & ".csv"
Name2 = Left(TName, Len(TName) - 5)

ret = MsgBox(Name1 & "を　FileName、" & Name2 & "を　区分に追加しますか？", vbYesNo + vbQuestion, "インポート確認")


Dim sql1 As String
sql1 = "Update T_Mas SET FileName = '" & Name1 & "',区分 = '" & Name2 & "'" & " WHERE FileName Is Null AND 区分 Is Null"
DoCmd.RunSQL sql1

End Sub

No.1 回答者： nora1962 回答日時： 2009/04/27 18:38

ACCESSのバージョンぐらい書きましょう。

それによって、対応方法も変わってくるかもしれません。

No.2 回答者： 30246kiku 回答日時： 2009/04/27 21:04

基本的な部分だけ、

応用は如何様にもできると思います。

フォーム表示時に、リストボックス「lst00」に対象フォルダ
「E:\Access\2007\tmp」にある XXX.txt（拡張子「txt」）を
リストボックス「lst00」に拡張子なし名で表示する例です。
（リストボックスの「値集合タイプ」は、「値リスト」にしておきます）
（リストボックスはプロパティで「複数選択」を「拡張」に変更しておきます）
（※複数選択に関して、ヘルプを参照してください）

Private Sub Form_Load()
　　Dim oFSO As Object
　　Dim oFile As Object
　　Dim sTmp As String
　　Const FolderPath = "E:\Access\2007\tmp"

　　sTmp = ""
　　Set oFSO = CreateObject("Scripting.FileSystemObject")
　　For Each oFile In oFSO.GetFolder(FolderPath).files
　　　　If (Right(oFile.Name, 3) = "txt") Then
　　　　　　sTmp = sTmp & ";" & Left(oFile.Name, InStr(oFile.Name, ".") - 1)
　　　　End If
　　Next
　　If (Len(sTmp) > 0) Then
　　　　sTmp = Mid(sTmp, 2)
　　End If
　　Me.lst00.RowSource = sTmp
　　Me.lst00 = Null
　　Set oFSO = Nothing
End Sub



Private Sub Cmd_01_Click()　では、選択されたものに対して、処理を行えばよいと思います。

　　Dim vTmp As Variant

　　sTmp = ""
　　For Each vTmp In Me.lst00.ItemsSelected
　　　　・・・・ Me.lst00.Column(0, vTmp)

で、選択されたファイル名が分かるので、
Me.lst00.Column(0, vTmp) & ".txt" でファイルの名前、
FolderPath & "\" & Me.lst00.Column(0, vTmp) & ".txt" でフルパスの名前が得られます。


補足：余談）
SQL = "INSERT INTO T_Mas (ID1,ID,処理状況,請求日,・・・
の中で、TName を代入的に生成していますが、
SQL = "INSERT INTO T_Mas (ID1,ID,処理状況,請求日,・・・ [XXX].・・・
とか、テーブル名を置き換える部分を XXX 名で作っておきます。
テーブル名を換える場合、 Replace で置き換えします。

上記XXXで作っておいたものを　CONSTSQL と仮定した場合、
SQL = Replace(CONSTSQL,"XXX",TName)

ソース（記述）を見た時、何をやっているか、よりイメージしやすくなると思います。