Here is a sample module
Sub ImportFiles()
Dim DirPath As String, DirName As String, FileName As String
Dim DirArray(500) As String, i As Integer, j As Integer
Dim FileName2 As String, FolderPath As String
DirPath = "C:\data\excel\"
DirName = Dir(DirPath, vbDirectory) ' Initialize directory
Do Until DirName = "" ' Find all the directory names
If Left(Right(DirName, 4), 1) = "." Or Left(DirName, 1) = "." Then
Else
i = i + 1
DirArray(i) = DirName ' Load array
End If
DirName = Dir() ' get next directory name
Loop
For j = 1 To i
FolderPath = DirPath & DirArray(j) & "\*.xls"
FileName = Dir(FolderPath, vbDirectory)
If FileName <> "" Then
Do Until FileName = ""
FileName2 = DirPath & DirArray(j) & "\" & FileName
DoCmd.TransferSpreadsheet acImport, 8, "TableName", FileName2, True
FileName = Dir()
Loop
End If
Next j
End Sub
Terry
------------------------------------
Blessed is the man who, having nothing to say, abstains from giving us worthy evidence of the fact. -George Eliot