Hi,

hier eine Funktion, die dir eine Liste zurückgibt, welche alle Files in einer Struktur enthält:

Private Sub TestAufruf()
Dim List$()
Dim a&, E&
Dim Ret

    'get files
    Ret = getFiles(List, "C:\", True)
    
    'error?
    Select Case Ret
    Case False
        MsgBox "Unexpected exception.", vbCritical
        Exit Sub
    Case True
    Case Else
        MsgBox Ret, vbCritical
        Exit Sub
    End Select
    
    'display data
    E = UBound(List)
    For a = 0 To E
        Debug.Print List(a)
    Next
    MsgBox E + 1 & " files gefunden."
    
End Sub
Function getFiles( _
List$(), ByVal Path$, _
Optional ByVal Subfolders As Boolean = False, _
Optional ByVal FilenameFilter$ = "*", _
Optional ByVal ExtensionFilter$ = "*" _
) As Variant
    
    'check for errors
        If Dir(Path) = "" Then
            getFiles = "Folder doesn't exist"
            Exit Function
        End If
    'start search
        getFiles = ListFiles(List, Path, Subfolders, FilenameFilter, ExtensionFilter)
        
End Function

Private Function ListFiles(List$(), ByVal Path$, ByVal Subfolders As Boolean, ByVal FilenameFilter$, ByVal ExtensionFilter$, _
Optional ByRef a& = -1) As Boolean
Dim oFS As Object, OFolder As Object, oSubfolder As Object, OFile As Object
Dim E&, b&, tmp$
On Error GoTo FileListingFailed

    'set
        Set oFS = CreateObject("Scripting.FileSystemObject")
        Set OFolder = oFS.GetFolder(Path)

    'search
        'subfolders
            If Subfolders Then
                For Each oSubfolder In OFolder.Subfolders
                    ListFiles List, oSubfolder.Path, Subfolders, FilenameFilter, ExtensionFilter, a
                Next
            End If
                
        'folder
            E = OFolder.FILES.Count
            If E = 0 Then Exit Function
            ReDim Preserve List(a + E)
            
            tmp = Dir(Path & "\" & FilenameFilter & "*" & ExtensionFilter)
            While tmp <> ""
                a = a + 1
                List(a) = Path & "\" & tmp
                tmp = Dir
            Wend
            ReDim Preserve List(a)
            
ListFiles = True
FileListingFailed:
    'reset
        Set OFolder = Nothing
        Set oFS = Nothing
        Set oSubfolder = Nothing
        Set OFile = Nothing

End Function

Ansonsten kannst du auch nach einfach nach rekursiven Methoden für Dateiauflistungen suchen, oder dir diesen Thread anschauen:

http://www.vba-forum.de/Forum/View.aspx?ziel=12330-Unterordner_durchsuchen_+_Datei_Import

Gruß

Till