Sub coShowFolderList(Optional FolderSpec As String = "c:\", Optional FolderTyp _
  As String = "")
Dim objFSO As New FileSystemObject
Dim objFile As Folder, objFile1 As Folder
Dim strFolder As String, bolSubFolder As Boolean
Dim valErr As Long
 
On Error GoTo Err_Proc
 
    'Werden Unterverzeichnisse mit berücksichtigt
    If InStr(1, FolderSpec, "*") > 0 Then
        strFolder = Mid(FolderSpec, 1, InStr(1, FolderSpec, "*") - 1)
        bolSubFolder = True
    Else
        strFolder = FolderSpec
        bolSubFolder = False
    End If
 
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.GetFolder(strFolder)
 
    For Each objFile1 In objFile.SubFolders
        rs.AddNew
            rs!temp_Path = objFile1.Path
            rs!temp_Typ = FolderTyp
        rs.Update
 
        If bolSubFolder Then
            coShowFolderList objFile1.Path & "*", FolderTyp
        End If
 
    Next objFile1
 
exit_Proc:
    On Error GoTo 0
 
    Set objFile1 = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing
 
    Exit Sub
Err_Proc:
    valErr = Err.Number
    Select Case valErr
        Case 76 'Verzeichnis exisitert nicht
            With coLog
                .LogActionTyp = "VER"
                .LogSource = "coShowFolderList"
                .LogResult = 22
                .LogFile = ""
                .NewLog "Das angegebene Verzeichnis " _
                            & UCase(strFolder) _
                            & " exisitiert nicht, oder ist nicht im Zugriff"
            End With
            ' und raus
            GoTo exit_Proc
 
        Case Else
            'Fehler-Eintrag im Logbuch
            With coLog
                .LogActionTyp = "VER"
                .LogSource = "coShowFolderList"
                .LogResult = 22
                .LogFile = ""
                .NewLog "Fehler: " & Err.Number & " Beschreibung:" & _
                  Err.Description
            End With
    End Select
 
    Err.Clear
    'und weiter
    Resume Next
 
End Sub
 
Sub coStoreFile(strPfad As String, Optional FolderTyp As String = "")
 
Dim objFSO As New FileSystemObject
Dim objFile As File
 
On Error GoTo Err_Proc
 
    For Each objFile In objFSO.GetFolder(strPfad).Files
        With objFile
            'alle Files in die Temp-Tabelle eintragen, Außer Temporäre mit ~
            If InStr(1, .Name, "~") = 0 Then
                rs.AddNew
                    rs!temp_FileName = .Name
                    rs!temp_FileExt = coExt(.Name)
                    rs!temp_Path = strPfad
                    rs!temp_FileDate = .DateCreated
                    rs!temp_FileModify = .DateLastModified
                    rs!temp_FileCreate = .DateCreated
                    rs!temp_FileAccess = .DateLastAccessed
                    rs!temp_Typ = FolderTyp
                rs.Update
            End If
        End With
    Next objFile
exit_Proc:
    On Error GoTo 0
 
    Set objFile = Nothing
    Set objFSO = Nothing
 
    Exit Sub
Err_Proc:
 
    'Fehler-Eintrag im Logbuch
    With coLog
        .LogActionTyp = "VER"
        .LogSource = "coStoreFile"
        .LogResult = 22
        .LogFile = ""
        .NewLog "Fehler: " & Err.Number & " Beschreibung:" & Err.Description
    End With
    Err.Clear
    'und weiter
    Resume Next
 
End Sub

Gru?
SR