Dateiliste in Excel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

hallo, nachstehender code von Ramses (Rainer) liest dir aus gewähltem verzeichnis alle zb xls-files aus -
darauf kannst du aufsetzen und dann die einzelnnen dateien die zellen abfragen

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

Dim sFile As String, sPath As String
Application.ScreenUpdating = False
sPath = "C:\Test"
If Right(sPath, 1) <> "/" Then sPath = sPath & "\"
sFile = Dir(sPath & "*.xls")
Do While sFile <> ""
Workbooks.Open sPath & sFile
zeilennr = Range("A65536").End(xlUp).Row + 1
Workbooks("Ergebnis.xls").Sheets(1).Cells(zeilennr, 1) = sFile
Workbooks("Ergebnis.xls").Sheets(1).Cells(zeilennr, 2) = Workbooks(sFile).Sheets(1).Range("A1")
Workbooks("Ergebnis.xls").Sheets(1).Cells(zeilennr, 3) = Workbooks(sFile).Sheets(1).Range("B1")
Windows(sFile).Close False
sFile = Dir()
Loop
Application.ScreenUpdating = True

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

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread