Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1472to1476
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Ordner mir U-Ordner + Dateien einlesen

Ordner mir U-Ordner + Dateien einlesen
15.02.2016 14:57:01
Piet
Hallo an alle und an Daniel
und ein herzliches Dankeschön an Luc
ich habe ein Programm von Daniel gesehen das mir sehr gefaellt.
Seine Antwort auf: Ordnerstruktur einlesen - Jaylan 06.02.2016 17:08:55
Hier werden die Ordner eingelesen, mit Anzahl der Dateien im Ordner,
aber nicht die Dateien als Text. Waere sehr schön die mit aufzulisten.
D.h. Ordner mit allen U-Ordnern, und den enthaltenen Dateien.
Meine Makro Kenntnisse sind bescheiden, mit Array und ReDim habe ich mich
noch nie beschaeftigt. Mein Versuch das Makro zu erweitern klappt nicht.
Wie kann man das verwirklichen? Wie funktioniert -ReDim Preserve-?
Über Hilfe würde ich mich sehr freuen.
An dieser Stelle noch ein herzliches Dankeschön an Luc.
Er sah in einem Makro von mir den Flüchtigkeitsfehler mit dem Komma.
PS:
Ein Frager nannte mich einmal "Piet den grossen", ich bleibe lieber bescheiden!
mit den echten Profis kann ich mich nicht vergleichen, dafür habe ich zu wenig Fachwissen.
Das habe ich den den Makros die ich im Forum sah sehr schnell erkannt!
mfg Piet
' AW: Makro von Daniel
Sub DateienZählen()
Dim Ordner() As String
Dim Zähler() As Long
Dim I As Long
Dim DATEI As String
Dim Files() As String   'neu eingefügt
ReDim Files(0)
ReDim Ordner(0)
ReDim Zähler(0)
Ordner(0) = "F:\"  'ganzes Laufwerk
Do While I  ""
If (GetAttr(Ordner(I) & DATEI) And vbDirectory) = vbDirectory Then
If Not DATEI Like ".*" Then
ReDim Preserve Ordner(UBound(Ordner) + 1)
ReDim Preserve Zähler(UBound(Zähler) + 1)
Ordner(UBound(Ordner)) = Ordner(I) & DATEI & "\"
End If
Else 'Zähler ORİGİNAL ; Files neu eingefüt
ReDim Preserve Files(UBound(Files) + 1)
Files(UBound(Files)) = Files(I) & DATEI & "  \"
Zähler(I) = Zähler(I) + 1
End If
DATEI = Dir
Loop
I = I + 1
Loop
Range("A:C").ClearContents
Cells(1, 1).Resize(UBound(Ordner) + 1).Value = WorksheetFunction.Transpose(Ordner)
Cells(1, 2).Resize(UBound(Zähler) + 1).Value = WorksheetFunction.Transpose(Zähler)
Cells(1, 3).Resize(UBound(Files) + 1).Value = WorksheetFunction.Transpose(Files)
End Sub

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ordner mir U-Ordner + Dateien einlesen
15.02.2016 15:23:22
Rudi
Hallo,
also eine Dateiliste?
Option Explicit
Sub DateiListe()
Dim FSO As Object, oFolder As Object, oDictF As Object
Dim strFolder As String, arrHeader, wksListe As Worksheet
Dim lngColumns As Long
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Ordner wählen"
.AllowMultiSelect = False
If .Show = -1 Then
strFolder = .SelectedItems(1)
End If
End With
If strFolder = "" Then Exit Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(strFolder)
Set oDictF = CreateObject("Scripting.dictionary")
arrHeader = Array("Name", "Ext", "Ordner", "kB", "le.Änd.", "Erstellt", "Pfad", "Link")
lngColumns = UBound(arrHeader) + 1
prcFiles oFolder, oDictF
prcSubFolders oFolder, oDictF
On Error Resume Next
Set wksListe = ThisWorkbook.Sheets("DateiListe")
On Error GoTo 0
If wksListe Is Nothing Then
Set wksListe = Worksheets.Add(before:=Sheets(1))
wksListe.Name = "DateiListe"
End If
With wksListe
.Cells.Clear
.Cells(1, 1).Resize(, lngColumns) = arrHeader
.Cells(1, 1).Resize(, lngColumns).Font.Bold = True
If oDictF.Count > 0 Then
.Cells(2, 1).Resize(oDictF.Count, lngColumns) _
= WorksheetFunction.Transpose(WorksheetFunction.Transpose(oDictF.Items))
Else
With .Cells(2, 1)
.Value = "No Files in " & oFolder
With .Font
.Bold = True
.Size = 16
.Color = RGB(255, 0, 0)
End With
End With
End If
.Columns.AutoFit
.Activate
End With
End Sub
Sub prcFiles(oFolder, oDictF)
Dim oFile As Object
For Each oFile In oFolder.Files
With oFile
oDictF(.Path) = Array( _
Left(.Name, InStrRev(.Name, ".") - 1), _
Replace(.Name, Left(.Name, InStrRev(.Name, ".")), ""), _
oFolder, _
Int(.Size / 1024), _
.DateLastModified, _
.DateCreated, _
.Path, _
"=HYPERLINK(""" & .Path & """;""" & "Klick" & """)")
End With
Next
End Sub
Sub prcSubFolders(oFolder, oDictF)
Dim oSubFolder As Object
For Each oSubFolder In oFolder.SubFolders
prcFiles oSubFolder, oDictF
prcSubFolders oSubFolder, oDictF
Next
End Sub
Gruß
Rudi

Anzeige
AW: Ordner mir U-Ordner + Dateien einlesen
16.02.2016 00:08:20
Piet
Hallo Rudi
danke für die schnelle Antwort, herzlichen Dank für deine Mühe.
Ein so umfangreiches Programm habe ich nicht erwartet.
Es erstellt das Blatt "Datei Liste" traegt auch den ersten Namen ein, mit Ordner usw.
Leider kommt genau an dieser Stelle ein Laufzeitfehler: Woran kann es liegen?
.Cells(2, 1).Resize(oDictF.Count, lngColumns) _
= WorksheetFunction.Transpose(WorksheetFunction.Transpose(oDictF.Items))
mfg Piet

AW: Ordner mir U-Ordner + Dateien einlesen
16.02.2016 10:29:19
Rudi
Hallo,
war keine Mühe. Alter Code.
    If oDictF.Count > 0 Then
.Cells(2, 1).Resize(oDictF.Count, lngColumns).FormulaLocal _
= WorksheetFunction.Transpose(WorksheetFunction.Transpose(oDictF.Items))
Gruß
Rudi

Anzeige
AW: Danke so funktioniert es (owt)
16.02.2016 11:57:06
Piet
..

AW: Ordner mir U-Ordner + Dateien einlesen
16.02.2016 18:59:50
Werner
Hi Rudi,
cool .. nur bei einem "Start-Verzeichnis" c:\...\_\
(also ein Unterstrich) kommt eine Fehlermeldung
Laufzeitfehler 5 - ungültige Procedure ....
und VBA stoppt bei
oDictF(.Path) = Array( _
Left(.Name, InStrRev(.Name, ".") - 1), _
Replace(.Name, Left(.Name, InStrRev(.Name, ".")), ""), _
oFolder, _
Int(.Size / 1024), _
.DateLastModified, _
.DateCreated, _
.Path, _
"=HYPERLINK(""" & .Path & """;""" & "Klick" & """)")
Auch nach Umbenennung in c:\...\aa\ erscheint der Fehler.
Andere Verzeichnisse funktionieren sehr gut !
Ne Idee ?
Danke vorab und besten Gruss
Werner
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige