No2の方の答えとかなりかぶるけど、せっかく書いたからとりあえず載せておく。
こっちは、ＦＳＯとＡＤＯを使っているので参照設定で
Microsoft ActiveX Data Objects Library のひとつと
Microsoft Scripting Runtime
にチェックを入れる必要がある。 サブフォルダを検索ということになると再起処理を行うことによって可能。
Private Sub コマンド0_Click()
Dim strPath As String
Dim FSO As New FileSystemObject
Dim objFLD As Folder
Dim objFLS As File
Dim CON As ADODB.Connection
Dim strSQL As String
Set CON = CurrentProject.Connection
strPath = "C:\Documents and Settings\Administrator\My Documents"
Set objFLD = FSO.GetFolder(strPath)
For Each objFLS In objFLD.Files
If Right(objFLS.Name, 4) = ".mdb" Then
strSQL = "INSERT INTO TABLE1 VALUES ('" & objFLS.Name & "')"
CON.Execute strSQL
End If
Next
Set CON = Nothing
Set objFLS = Nothing
Set objFLD = Nothing
Set FSO = Nothing
End Sub
http://oshiete1.watch.impress.co.jp/qa6994409.html
のNo1を少し改良して。
フォルダ名を「マイフォルダ」とします。
テーブル名を「Tファイル」とし、フィールド名を「ファイル名」とします。
フィールドはフルパスを格納する場合はメモ型にしないとデータがあふれて、
エラーがでる可能性があります。
以下はDAOを使っているのでDAOにチェックをいれてください。
Sub test()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strPath As String
Dim myFile As String
'strPath = "C:\Documents and Settings\user\デスクトップ\マイフォルダ"
strPath = CurrentProject.Path & "\マイフォルダ"
Set db = CurrentDb
Set rs = db.OpenRecordset("Tファイル", dbOpenDynaset)
myFile = Dir(strPath & "\*.*", vbNormal)
'ファイルの検索、取り出し
Do While myFile <> ""
rs.AddNew
rs!ファイル名 = strPath & myFile
rs.Update
myFile = Dir()
Loop
rs.Close: Set rs = Nothing
db.Close: Set db = Nothing
End Sub
Acceeファイルを置いている同じフォルダにフォルダが
存在する場合は、フォルダまでのパスは、
strPath = CurrentProject.Path & "\マイフォルダ"
フルパスで指定する場合は、その上の方法で。
