Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 17:41:19
Link erstellen mit Formel oder VBA?
23.04.2024 17:00:22
Summe und Ausgabe
23.04.2024 16:27:34
Excel Starthinweis - Arbeitsmappenleistung überprüfen ...
23.04.2024 16:15:16
Mittels VBA vordefinierte Kommentare in Zellen einfügen?
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1004to1008
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1004to1008
1004to1008
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Dateien auflisten code abändern

Dateien auflisten code abändern
27.08.2008 21:07:04
Rocky
Hallo fans,
ich habe gestern von Tom den folgenden Code bekommen.
Option Explicit
Dim FSO, FO, FU, F
Dim lRow As Long
Dim icol As Integer

Public Sub Ordner_Auflisten()
Set FSO = CreateObject("Scripting.FileSystemObject")
icol = 0
lRow = 0
GetSubFolders "U:\"
End Sub


Function GetSubFolders(Pfad)
Set FO = FSO.GetFolder(Pfad)
Set FU = FO.SubFolders
On Error Resume Next
For Each F In FU
lRow = lRow + 1
icol = icol + 1
Cells(lRow, icol) = F.Name
GetSubFolders F.Path
Next
icol = icol - 1
End Function


mit diesem werden alle Ordner in einem Verzeichnis in Zeilen und Spalten aufgelistet.
Das ist super so wie es ist. ich hatte jetzt noch gern die darin befindlichen dateien mit darin.
kann mir jemand den Code abändern.
Danke euch
Rocky

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

Betreff
Datum
Anwender
Anzeige
AW: Dateien auflisten code abändern
28.08.2008 14:37:36
fcs
Hallo Rocky,
mit folgenden Anpassungen werden die Dateien nach dem Ordner um 1 Spalte nach rechts versetzt gelistet.
Die Berücksichtigung der Leseberechtigung für die Unterordner machte das ganze leider etwas komplizierter. Falls man diese weglässt, dann werden ggf. die Spalten nicht korrekt angeordnet.
Gruß
Franz

Option Explicit
Dim FSO, FO, FU, F
Dim lRow As Long
Dim icol As Integer
Public Sub Ordner_Auflisten()
Application.ScreenUpdating = False
Set FSO = CreateObject("Scripting.FileSystemObject")
icol = 0
lRow = 0
ActiveSheet.UsedRange.Clear
Call DateienListen(strPath:="U:\")
GetSubFolders "U:\"
Application.ScreenUpdating = True
MsgBox "Fertig"
End Sub
Function GetSubFolders(Pfad)
Set FO = FSO.GetFolder(Pfad)
Set FU = FO.SubFolders
On Error Resume Next
For Each F In FU
lRow = lRow + 1
icol = icol + 1
Cells(lRow, icol) = F.Name
If IsEmpty(F) Then 'Probleme beim Zugriff auf Unterordner
Cells(lRow, icol) = "!keine Leseberechtigung!"
icol = icol - 1
Else
If DateienListen(strPath:=F.Path) = False Then
Cells(lRow, icol) = "!Problem beim Dateien lesen!"
End If
End If
GetSubFolders F.Path
Next
icol = icol - 1
End Function
Private Function DateienListen(strPath As String) As Boolean
Dim objFile
On Error GoTo FEHLER
DateienListen = True
With Application.FileSearch
.NewSearch
.LookIn = strPath
.SearchSubFolders = False
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
For Each objFile In .FoundFiles
lRow = lRow + 1
Cells(lRow, icol + 1) = Replace(objFile, IIf(Right(strPath, 1) = "\", strPath, _
strPath & "\"), "")
Next
End If
End With
Exit Function
FEHLER:
'Fehler beim Auslesen des Ordners
DateienListen = False
End Function


Anzeige
Spitze
29.08.2008 07:37:02
Rocky
Mesch echt spitze.
hab mir erlaubt es um eine Ordnerauswahl zu erweitern:
Option Explicit
Dim FSO, FO, FU, F
Dim lRow As Long
Dim icol As Integer
Dim fd As FileDialog

Public Sub Ordner_Auflisten()
Application.ScreenUpdating = False
Set FSO = CreateObject("Scripting.FileSystemObject")
icol = 0
lRow = 0
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then
Call DateienListen(strPath:=(fd.SelectedItems(1)))
GetSubFolders (fd.SelectedItems(1))
Else
Exit Sub
End If
'ActiveSheet.UsedRange.Clear
Application.ScreenUpdating = True
MsgBox "Fertig"
End Sub


Function GetSubFolders(Pfad)
Set FO = FSO.GetFolder(Pfad)
Set FU = FO.SubFolders
On Error Resume Next
For Each F In FU
lRow = lRow + 1
icol = icol + 1
Cells(lRow, icol) = F.Name
If IsEmpty(F) Then 'Probleme beim Zugriff auf Unterordner
Cells(lRow, icol) = "!keine Leseberechtigung!"
icol = icol - 1
Else
If DateienListen(strPath:=F.Path) = False Then
Cells(lRow, icol) = "!Problem beim Dateien lesen!"
End If
End If
GetSubFolders F.Path
Next
icol = icol - 1
End Function 



Private Function DateienListen(strPath As String) As Boolean
Dim objFile
On Error GoTo FEHLER
DateienListen = True
With Application.FileSearch
.NewSearch
.LookIn = strPath
.SearchSubFolders = False
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
For Each objFile In .FoundFiles
lRow = lRow + 1
Cells(lRow, icol + 1) = Replace(objFile, IIf(Right(strPath, 1) = "\", strPath, _
strPath & "\"), "")
Next
End If
End With
Exit Function
FEHLER:
'Fehler beim Auslesen des Ordners
DateienListen = False
End Function


Danke nochmal.
Rocky
PS.: 'ActiveSheet.UsedRange.Clear hatte alles wieder gelöscht - hab ich rausgenommen

Anzeige
Ordner farbig?
29.08.2008 12:06:57
Rocky
Hallo,
nen kleinigkeit hab ich noch.
ist auch noch möglich die Ordner in einer anderen Farbe darzustellen. So das Sie einfacher von den aufgelisteten Datei zu unterscheiden sind.
Gruß und Danke sagt
Rocky
AW: Ordner farbig?
29.08.2008 19:51:00
fcs
Hallo Rocky,
zum Einfärben der Ordner in der folgenden Prozedur eine Zeile einfügen
Gruß
Franz

Function GetSubFolders(Pfad)
Set FO = FSO.GetFolder(Pfad)
Set FU = FO.SubFolders
On Error Resume Next
For Each F In FU
lRow = lRow + 1
icol = icol + 1
Cells(lRow, icol) = F.Name
Cells(lRow, icol).Interior.ColorIndex = 6           'gelb einfärben
If IsEmpty(F) Then 'Probleme beim Zugriff auf Unterordner
Cells(lRow, icol) = "!keine Leseberechtigung!"
icol = icol - 1
Else
If DateienListen(strPath:=F.Path) = False Then
Cells(lRow, icol) = "!Problem beim Dateien lesen!"
End If
End If
GetSubFolders F.Path
Next
icol = icol - 1
End Function


Anzeige
Genial
30.08.2008 20:31:11
Rocky
Einfach super.
Genau was ich wollte.

Gruß Rocky




Wenn unter den Blinden der Einäugige König ist, dann findet man hier die Herren der Ringe!


299 Forumthreads zu ähnlichen Themen

@Hans W. Herber: 1 Million Beiträge - Glückwunsch
mpb

Hallo Hans,
wenn ich die URLs richtig interpretiere, haben wir im Forum soeben die Zahl von 1 Million Beiträgen überschritten.
Herzlichen Glückwunsch zu dem Erfolg Deines "Babys"!
Gruß
Martin
07.08.2008 16:23:47
Thread-ID: 1000004
3 Beiträge
Anzeige
automatisch Berechnen funktioniert nicht
t4z

Hi Leute,
kann mir jmd folgendes Phänomen erklären?
Excel-Datei enthält Formeln, die auf andere Zellen innerhalb der Mappe referenzieren. Die Quelldaten ändern sich, jedoch die Formeln nicht. Unter Extras-Optionen-Berechnung ist "automatisch" aktiv. Ein Drücken auf F9 bringt keinen Erfo...
07.08.2008 17:13:07
Thread-ID: 1000040
3 Beiträge
Aufruf UserForm
lasmik

hallo zusammen
wie kann ich dieses macro erweitern das es auch genau so ausgeführt wird wenn ich d3 anklicke.
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address = "$C$3" Then UserForm1.Show If Not Intersect(Target, Range("C3")) Is Nothin...
07.08.2008 18:04:57
Thread-ID: 1000062
7 Beiträge
Anzeige
Cursor springt in die Pampa - MultiLine TextBox
Kilo

Hallo liebe VBA Profis
ich bin auf ein für mich nicht lösbares Problem - vielleicht sogar Phänomen gestoßen...
Leider kann ich keine Phänomene dieser Art gebrauchen.
Damit es für Sie etwas anschaulicher wird, hab ich mein Problem als Beispiel (https://www.herber.de/bbs/user/54427.xl...
07.08.2008 20:31:08
Thread-ID: 1000095
2 Beiträge
Formel automatisch durch Wert ersetzen (vba)
Tanja

Hallo liebe Leute,
Ich hab in meiner excel-Mappe, in den Zellen: M2:M14 Formeln, die eine ganze Zahl als Ergebnis erzeugen.
So, und nun möchte ich das 1. Berechnungs-Ergebnis quasi "einfrieren".
Mein Problem: Ich möchte kein Makro per Hand auslösen müssen, sondern der Code soll voll...
07.08.2008 21:59:00
Thread-ID: 1000110
5 Beiträge
Farbige Zellen suchen und Zuordnung auflisten
Excel-Opfer

Hallo zusammen,
ich hab nicht so die Ahnung von Makros und Automationen im Excel, bräuchte allerdings "dringend" eine Vereinfachung meines Excelchaos.
es dreht sich um folgende Problematik:
ich muss diverse Dienstpläne in unsere Personalplanung einarbeiten, leider liefert eine Abtei...
08.08.2008 06:47:00
Thread-ID: 1000143
16 Beiträge
Komplizierte Wenn-Formel für kicker-Spiel
Frank

Hallo miteinander,
ich möchte eine Excel-Datei für das offizielle Fussball-kicker-Managerspiel erstellen, leider scheitere ich total an (vermutlich) den WENN-Formeln ..... vielleicht ist das aber auch gar nicht möglich, was ich erreichen möchte :-(
In der Tabelle sollte man in Spalte A...
08.08.2008 07:28:06
Thread-ID: 1000146
4 Beiträge
AW: Excel Makro Starten
Matty

Hallo nochmal....
Was ist an meiner Variante falsch?
Ich habe die Dateinamen als String definiert und in der Schleife den String aufgerufen. Was ist an dem Aufruf Application.Run falsch bzw was muss ich anders formulieren, wenn ich möchte dass die dateien entsprechend der Schleife durch...
08.08.2008 07:42:54
Thread-ID: 1000149
2 Beiträge
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge
2
2
2
6
10
1
4
15
3
1
4
2
6
1
2
2
3
2
6
4
4
9
1
6
4