Hallo liebes VBA Team und ein frohes Fest an dieser Stelle.... ;)

ich habe einen netten Code gefunden der mir aus Ordnern und Unterordnern alle Dateien raussucht und auflistet....danach macht er auch gleich

noch einen Link daraus.....funktioniert wunderbar.

Jetzt reicht es mir aber völlig, wenn er mir die Textdateien rausgibt....alles ander ist einfach zu viel und man blickt nicht mehr durch.

also entweder ganz einfach nur nach textdateien suchen und ausgeben, oder mit einer variante, das man sich den dateityp auswählen kann....wäre auch sehr schön.

hier ist mal der Code:

Option Explicit
Option Compare Text

Const sRootPath As String = "C:\Projekte" 'Pfad bitte anpassen ohne Trennzeichen am Ende!!!
Private lRowCounter As Long
Private oSheet As Object

'Start der Routine: Call MWDateienMitUnterordnernAuslesen

Public Sub MWDateienMitUnterordnernAuslesen()



     Set oSheet = Sheets.Add
     oSheet.Activate
     oSheet.Cells(1, 1).Select
     Call CreateHeadLinesAndFormat
     lRowCounter = 2
     Call MWReadSubFolder(sRootPath)
     Set oSheet = Nothing
     Call HLinks ' Hyperlinks erzeugen
     
End Sub

Private Sub CreateHeadLinesAndFormat()
   Dim i As Long
    
     oSheet.Cells(1, 1) = "Pfad"
     oSheet.Cells(1, 2) = "Dateiname"
     oSheet.Cells(1, 3) = "Änderungsdatum"
     
     
     oSheet.Columns(1).ColumnWidth = 40
     oSheet.Columns(2).ColumnWidth = 40
      oSheet.Columns(3).ColumnWidth = 40
    
     For i = 1 To 2
         With oSheet
             .Cells(1, i).Interior.ColorIndex = 11
             .Cells(1, i).Font.Color = vbWhite
             .Cells(1, i).Font.Bold = True
         End With
     Next i
End Sub

Private Sub MWReadSubFolder(ByVal sPath As String)
   Dim oFSO As Object
   Dim oFolder As Object
   Dim oSubFolder As Object
   Dim oFile As Object
    
     Set oFSO = CreateObject("Scripting.FileSystemObject")
     Set oFolder = oFSO.GetFolder(sPath)
    
     With oSheet
    
         For Each oSubFolder In oFolder.subfolders
        
             'Alle Dateien auflisten
             For Each oFile In oSubFolder.Files
                 .Cells(lRowCounter, 1) = oSubFolder.Path
                 .Cells(lRowCounter, 2) = oFile.Name
                  .Cells(lRowCounter, 3) = oFile.DateLastModified
                 lRowCounter = lRowCounter + 1
             Next oFile
            
             'Alle Unterverzeichnisse verarbeiten (rekursiv)
             Call MWReadSubFolder(oSubFolder.Path)
        
         Next oSubFolder
    
     End With
    
     Set oFSO = Nothing
     Set oFile = Nothing
     Set oFolder = Nothing
     Set oSubFolder = Nothing
End Sub



Wäre Euch sehr dankbar, wenn Ihr dort mal drüber schauen könntet....