Ordner auslesen und Hyperlinks erstellen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Mablu
gratuliere, jetzt hast du viele technische Erklaerungen, die technisch einwandfrei sind! Lösen sie dein Problem?
Als alter Praktiker habe ich mich selbst mit dem Problem Ordner auflisten herumgeschlagen.
Meine Antwort:
das ganze Laufwerk C auflisten macht wenig Sinn, weil du 80 % "Datenmüll" auflistet!!
Das sind alles Systemdateien, Programme mit Unter-Ordner, die dich sicher nicht interessieren, oder irre ich mich da?
Die internen Dateien können locker über 100.000 sein, die für dich wichtigen Dateien sind vielleicht nur 1-2000 Stück
Was machst du mit dem Rest, willst du da überall Hyperlinks einbauen.- Dann viel Spass ... beim testen
Ich kenne Codes von Nepumuk, Hajo und vielen anderen. Die listen sturheil alles auf, jeden Pipifacks, egal ab das "weh tut"
Mein eigenes Programm, Uralt, noch Reversive, listet auf Wunsch z.B. alle HTML Dateien nur als Ordner auf, KEINE Inhalte!!.
Tauch bitte mal im Intenet, mein Programm ist ein Unikat, du findest es nirgendwo. Ich habe mehrer Auflist Versionen, überspringe auch Ordner mit einer "No Liste", wo ich dem Makro gezielt sagen kann ob ein kompletter Ordner gelistet werden soll oder nicht.
Ich schaue mir jezt mal deine Beispieldatei an. Und noch ein Vorteil der alten Excel 97 Progarmmierung.
Stürzt mein Programm ab, sehe ich wo er haengen bleibt, weil ich NICHT über Array aufliste,sondern jede Zeile direkt in die Tabelle schreibe. Dann siehtst du genau welche Datei den Absturz verursacht hat. Das gibt es bei mir auch mal. Dann setze ich ins Makro den Befehl: - überspringe genau diesen Ordner oder Datei!
Oft sind es interne System Dateien die du nicht im Explorer sieht wie: "System Volume Information oder "$RECEYCLING".
Da haengt Excel sich gerne auf. Beim Array findest du solche Fehler nie. Man sieht ja nicht wo Excel sich aufhaengt.
mfg Piet

Hallo MaBlu
ich hatte schon oft Aerger mit dem Ordner den du benennst, dann gibt es noch "RECEYCLING" und "System Volume Information". Manche werden im Explorer nicht angezeigt. Ich habe dir mal zwei Sprungbefehle mit IF Instr() eingebaut. Teste es bitte mal damit.
Anbei noch eine uralte Datei von 1994 aus dem Internet. Sie funktioniert immer noch, und ist deiner Mappe beim auflisten eines LW zeitlich bestimmt haushoch überlegen. Das trotz Asbach uralter Reverse Technik aus Excel 97 Zeit. Da muss man sich echt wundern. Vor allem kann ich im Makro einstellen ob ich HTML Ordner als Ordner oder jedes einzelne Blatt auflisten will. - (Unnötiger Müll!!)
Schau dir mal den Unterschied in Tabelle1 und Tabelle2 bitte selbst an, und achte auf die benötigte Zeiten.
Die Aufmachung wie ich Ordner aufliste ist nicht Standard wie die Kollegen es machen. Mir gefiel diese Art optisch besser, denn das Internet Original machte es wie gehabt. Der Vorteil: - diese alte Kamelle kann jeder der VBA Kenntnisee hat verstehen, und nach belieben umschrieben. Für Hyperlink muss man den Code erweitern, das ist aber kein grosses Problem.
Bei Fehler verschluckt es sich schon mal und listet nicht mehr sauber auf. Den Fehler habe ich noch nicht gefunden.
Für einfache User Anwendungen ist dieser Code trotz seines Alters gut zu gebrauchen.
mfg Piet

    Do While TB1.Cells(Rows.Count, 1).End(xlUp).Row  TB1.Cells(Rows.Count, 2).End(xlUp).Row
For X2 = X0 To X1
Pfad1 = TB1.Cells(X2, 1)  ' Pfad setzen.
If Right(Pfad1, 1)  "\" Then Pfad1 = Pfad1 & "\"
Name1 = Dir(Pfad1, vbDirectory) ' Ersten Eintrag abrufen.
Verz = 0
Do While Name1  "" ' Schleife beginnen.
If InStr(Name1, "RECYCL") Then GoTo nx
If InStr(Name1, "System Volume") Then GoTo nx
' Aktuelles und übergeordnetes Verzeichnis ignorieren.
If Name1  "." And Name1  ".." Then
' Mit bit-weisem Vergleich sicherstellen, daß Name1 ein
' Verzeichnis ist.
If (GetAttr(Pfad1 & Name1) And vbDirectory) = vbDirectory Then
Anzahl = Anzahl + 1
TB1.Cells(Anzahl, 1) = Pfad1 & Name1 & "\"
Verz = Verz + 1
'Eintrag nur anzeigen, wenn es sich um ein Verzeichnis handelt.
End If
nx:     End If
Name1 = Dir ' Nächsten Eintrag abrufen.
Loop
TB1.Cells(X2, 2) = Verz
Next X2
X0 = X1 + 1
X1 = X2
Loop

https://www.herber.de/bbs/user/126983.xlsm

Sub Dateisuche2(Laufwerk, Dateien) '......... ab hier! Do While Len(temp) 'Hyperlink in Spalte C oder D einfügen!! C=3, D=4 ActiveSheet.Hyperlinks.Add Anchor:=Cells(z, 4), Address:=Laufwerk & temp Cells(z, 3) = Space(3) & temp 'nur Datei, ohne Ordnername

noli: temp = Dir(Laufwerk, vbDirectory) If unterordner = vbNo Then temp = "" Do While Len(temp) '** es gibt eine Variante wo ich hier Ordner in Spalte L prüfe 'und überspringe wenn in Spalte K ein "No" für -No List- steht If InStr(temp, "RECEYCLING") Then GoTo ny 'System Ordner von Micosoft If InStr(temp, "System Volumne") Then GoTo ny 'System Volume Information

'dieses Programm ruft sich selbst auf !! (bis Directory Ende) Sub Dateisuche2(Laufwerk, Dateien) Dim MB, temp, wdhlg, Ordner As String On Error GoTo fehler If Right(Laufwerk, 1) "\" Then Laufwerk = Laufwerk + "\" temp = Dir(Laufwerk & Dateien) z = z + 2 'von mir eingefügt !! n = z - 1 'Anf-Adresse retten (neue Zeile für Ordner) d = 0 'Datei löschen Application.StatusBar = f & " " & Laufwerk Application.ScreenUpdating = False Do While Len(temp) 'Hyperlink in Spalte C oder D einfügen!! C=3, D=4 ActiveSheet.Hyperlinks.Add Anchor:=Cells(z, 4), Address:=Laufwerk & temp Cells(z, 3) = Space(3) & temp 'nur Datei, ohne Ordnername Cells(z, 5) = FileLen(Laufwerk & temp) Cells(z, 6) = FileDateTime(Laufwerk & temp) If InStr(temp, ".") Then temp = Right(temp, 6) Else temp = Empty Cells(z, 4) = Right(temp, Len(temp) - InStrRev(temp, ".")) MB = MB + Cells(z, 5) z = z + 1 d = d + 1 'Anzahl Datei nx: temp = Dir() Loop 'If d = 0 Then z = z - 2: GoTo noli 'Summen: Dateien, Null Ordner + gByt addieren f = f + d: gMB = gMB + MB 'neue Zeile für Ordner If Len(Ordner) ".") And (temp "..") Then If (GetAttr(Laufwerk & temp) And vbDirectory) = vbDirectory Then If InStr(LCase(temp), "-dateien") Or _ InStr(LCase(temp), "-dates") Or _ InStr(LCase(temp), "_files") Or _ InStr(LCase(temp), "\files") Then _ If HTLM = "Ja" Then ht = ht + 1: GoTo ny Dateisuche2 Laufwerk & temp, Dateien o = o + 1 'Anzahl Ordner wdhlg = Dir(Laufwerk, vbDirectory) 'ohne Wdhlg endlose Wiederholung !! Do While wdhlg temp wdhlg = Dir() Loop ny: End If End If temp = Dir() Loop On Error GoTo 0 Application.StatusBar = False Exit Sub fehler: 'Ende bei Datei Error (s.97) If d + f + o = 0 Then [c3] = Error(): Exit Sub If Cells(z, 7) = "" Then fe = fe + 1 Cells(z, 7) = Error(): [c3] = fe & " Fehler" Resume Next End Sub

Beliebteste Forumthreads (12 Monate)

Ordner auslesen und Hyperlinks erstellen

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

30 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Ordner auslesen und Hyperlinks erstellen

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

30 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread