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....
|