Re: Dateiliste in Excel erzeugen
30.12.2002 14:33:56
Hajo
Hallo Harald
Option Explicit
Sub List_Files_in_all_folder()
' einschl unterordner von Ramses Rainer
' komplett mit Phad
Dim Dateiform As String
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
' suchen auch in Unterverzeichnis
.SearchSubFolders = True
.Filename = Dateiform
If .Execute() > 0 Then
TotFiles = .FoundFiles.Count
Application.StatusBar = "Total " & TotFiles & " gefunden"
For I = 1 To .FoundFiles.Count
gefFile = .FoundFiles(I)
'Eintragen der Dateien in die aktuelle Tabelle
'in Spalte A
Application.StatusBar = "Datei: " & I & " von " & TotFiles
Cells(I, 1) = gefFile
' ergänzt
Cells(I, 2) = FileLen(gefFile) ' Dateigröße
' ********
Next I
End If
End With
Application.StatusBar = OldStatus
Application.ScreenUpdating = True
End Sub
Sub List_Files_in_all_folder2()
' einschl unterordner von Ramses Rainer
' ohne Phad
Dim Dateiform As String
Dim I As Long, TotFiles As Long
Dim L As Integer
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
' suchen auch in Unterverzeichnis
.SearchSubFolders = True
.Filename = Dateiform
If .Execute() > 0 Then
TotFiles = .FoundFiles.Count
Application.StatusBar = "Total " & TotFiles & " gefunden"
For I = 1 To .FoundFiles.Count
gefFile = .FoundFiles(I)
'Eintragen der Dateien in die aktuelle Tabelle
'in Spalte A
Application.StatusBar = "Datei: " & I & " von " & TotFiles
' Ergänzt
For L = Len(gefFile) To 1 Step -1
If Mid(gefFile, L, 1) = "\" Then Exit For
Next L
' ******
' verändert
Cells(I, 1) = Mid(gefFile, L + 1, Len(gefFile) - L + 1)
' *****
' Cells(I, 1) = gefFile
' ergänzt
Cells(I, 2) = FileLen(gefFile) ' Dateigröße
' ********
Next I
End If
End With
Application.StatusBar = OldStatus
Application.ScreenUpdating = True
End Sub
Code eingefügt mit: Excel Code Jeanie
Code Jeanie
Frage
Das Umsetzen nach Html klappt perfekt, auch die Ansicht in den Foren ist gegeben. Bei manchen Foren kann man aber anscheinend nicht den dargestellten Code nach VBA rückkopieren. Warum?
Antwort
Dies liegt nicht an der Code Jeanie !!! Manche Foren interpretieren anscheinend < pre > < /pre > Tags nicht richtig und erzeugen am Zeilenende einen weichen Zeilenumbruch anstatt eines harten Zeilenumbruches. Dies führt dazu, dass im VBA-Editor die Zeilen hintereinander geschrieben werden. Zum Rückkopieren in solchen Fällen: Fügen Sie den kopierten Code aus dem Forum nach Word ein, kopieren Sie ihn dort wieder und fügen Sie ihn dann im VBA - Editor ein
Gruß Hajo