Kann man die ausgelesenen Daten auch sortieren bzw. nur unterschiedliche Daten anzeigen lassen? Wer kann mir weiter helfen?
Kann man die ausgelesenen Daten auch sortieren bzw. nur unterschiedliche Daten anzeigen lassen? Wer kann mir weiter helfen?
sub List_Files_in_all_folder2()
' jedes Unterverzeichnis in eine Spalte
' ergänzt
' einschl unterordner von Ramses Rainer
Dim Dateiform As String
Dim Verzeichnis As String
Dim J As Integer
Dim K As Long
Dim Bereich As Range
Dim Dateiname As String
J = 1: K = 2
Dim I As Long, TotFiles As Long
Dim gefFile As String, dname As String
Dim Suchpfad As String, suchbegriff As String
Dim OldStatus As Variant
Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Pfad definieren", Application.DefaultFilePath)
If Suchpfad = "" Then Exit Sub
Dateiform = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung", "*.xls")
If Dateiform = "" Then Exit Sub
Application.ScreenUpdating = True
OldStatus = Application.StatusBar
With Application.FileSearch
.LookIn = Suchpfad
.SearchSubFolders = True
' .SearchSubFolders = False
.Filename = Dateiform
If .Execute() > 0 Then
TotFiles = .FoundFiles.Count
Application.StatusBar = "Total " & TotFiles & " gefunden"
For I = 1 To .FoundFiles.Count
' ergänzt für Unterverzeichnis
' festellen aller Unterverzeichnisse und in Zeile 1 schreiben
Dim L As Integer
For L = Len(.FoundFiles(I)) To 1 Step -1
If Mid(.FoundFiles(I), L, 1) = "\" Then Exit For
Next L
If Verzeichnis = "" Then
Verzeichnis = Mid(.FoundFiles(I), 1, L)
Else
If Mid(.FoundFiles(I), 1, L) <> Verzeichnis Then
Verzeichnis = Mid(.FoundFiles(I), 1, L)
K = 2
End If
End If
Set Bereich = ActiveSheet.Range("A1:IV256").Find(Mid(.FoundFiles(I), 1, L), lookat:=xlWhole)
If Bereich Is Nothing Then
Cells(1, J) = Mid(.FoundFiles(I), 1, L)
J = J + 1
End If
Next I
' Dateienfeststellen
For I = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
Dateiname = Dir(Cells(1, I) & Dateiform)
Do While Dateiname <> ""
Cells(Cells(Rows.Count, I).End(xlUp).Row + 1, I).Value = Dateiname
K = K + 1
Dateiname = Dir
Loop
Next I
' ******
End If
End With
Application.StatusBar = OldStatus
Application.ScreenUpdating = True
End Sub
gruß
andreas e
http://www.skripteundaufgaben.de viele kostenlose Downloads und Lösungsansätze zu EXCEL und mehr
Hallo Markus
sPath = "C:\Test" musst du anpassen
Das Makro schreibt in der Datei, die "Ergebnis.xls" lauten muss, in Spalte A den Dateinnamen, in Spalte B den Inhalt von Zelle A1 und in Spalte C den Inhalt von Zelle B1.
Gruss
Chris
weitere "treffer" hier.
https://www.herber.de/forum/archiv/search/searchlist.htm
gruss thomas