ich habe in einem Ordner verschiedene Dateien sowie weitere
Unterordner, darin wieder verschiedene Dateien sowie weitere
Unterordner usw. Jetzt möchte ich eine Liste erzeugen, in der
in der Spalte A alle Dateien mit ihrem Namen aufgelistet
werden. In Spalte B wäre schön, wenn dazu der komplette Pfad
angezeigt würde. Ist das mit Excel zu lösen? Wie geht das?
Gibt es eine Funktion oder müsste das mit einem Makro gemacht
werden (kann leider nicht selbst programmieren, nur
aufnehmen…)?
Hallo Oliver,
Alt+F11, Einfügen—Modul, Kopier da den nachstehende Code rein.
Wie es im Code steht mußt du einen verweis setzen, das geht über Extras—Verweis, hak da
Microsoft Scripting Runtime
an.
Im Code kannst du über True oder False an der richtigen Stelle in
For Each Datei In GetFiles(„C:\test“, True, „*.xls“)
steuern ob Unterordner durchsucht werden oder nicht.
Mit z.B.
„*.doc“
anstatt
„*.xls“
kannst du steuern ob z.B. Word-Dokumente gelistet werden.
Wenn du das gfs. im Code angepasst hast schließt du den Vb-Editor. In Excel dann Alt+F8 und das makro „Dateilisten“ ausführen lassen.
Im grad aktuellen Blatt entsteht dann die Liste.
Gruß
Reinhard
Option Explicit
' Achtung!
' --\> Microsoft Scripting Runtime - Verweis notwendig!
Sub Dateilisten()
Dim Datei As File, Zei As Long
Application.ScreenUpdating = False
For Each Datei In GetFiles("C:\test", True, "\*.xls")
Zei = Zei + 1
Cells(Zei, 1) = Datei.Name
Cells(Zei, 2) = Datei.Path
Next
Application.ScreenUpdating = True
End Sub
'
Public Function GetFiles(FolderPath As String, scanSubDirectorys As Boolean, Optional \_
SearchPattern As String, Optional SortBy As String) As Collection
' Die MSR - Objekte
Dim objFs As New FileSystemObject
Dim objRootFolder As Folder
Dim objSubFolder As Folder
Dim objFile As File
' Zwischenspeicher für den Rückgabewert der Funktion
Dim HColl As New Collection
Set HColl = Nothing
' Wenn kein Suchmuster angegeben alle Dateien zurückliefern
If SearchPattern = "" Then SearchPattern = "\*"
' Das Ordner-Objekt für den angegebenen Pfad laden
On Error GoTo err01
Set objRootFolder = objFs.GetFolder(FolderPath)
err01:
If Err.Number 0 Then
Set GetFiles = HColl
Exit Function
End If
' Alle Dateien in diesem Ordner durchlaufen
For Each objFile In objRootFolder.Files
' Wenn das Suchmuster übereinstimmt Datei der Collection hinzufügen
If objFile.Name Like SearchPattern Then
HColl.Add objFile
End If
Next
' Wenn angegeben, die Unterordner des Startpfades durchlaufen
If scanSubDirectorys Then
For Each objSubFolder In objRootFolder.SubFolders
' Alle per Rekursion zurückgelieferten Dateien der Hilfscollection hinzufügen
For Each objFile In GetFiles(objSubFolder.Path, scanSubDirectorys, SearchPattern)
HColl.Add objFile
Next
Next
End If
' Wenn angegeben, die Hilfs-Collection sortieren
If SortBy "" Then
Set HColl = SortItemCollection(HColl, SortBy)
End If
' Rückgabewert
Set GetFiles = HColl
End Function
'
Public Function SortItemCollection(col As Collection, strPropertyName) As Collection
Dim colNew As Collection
Dim objCurrent As Object
Dim objCompare As Object
Dim lngCompareIndex As Long
Dim variantCurrent As Variant
Dim variantCompare As Variant
Dim blnGreaterValueFound As Boolean
'make a copy of the collection, ripping through it one item
'at a time, adding to new collection in right order...
Set colNew = New Collection
For Each objCurrent In col
'get value of current item...
variantCurrent = CallByName(objCurrent, strPropertyName, VbGet)
'setup for compare loop
blnGreaterValueFound = False
lngCompareIndex = 0
For Each objCompare In colNew
lngCompareIndex = lngCompareIndex + 1
variantCompare = CallByName(objCompare, strPropertyName, VbGet)
'die Vergleichstypen auf Variant geändert, somit können beliebige Datentypen \_
miteinander verglichen werden
If variantCurrent
