Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 17:05:40
Zählen von Zeilen, in denen in bestimmten Bereich Daten sind
19.04.2024 16:34:52
gemeinsamer Filter über drei Spalten
19.04.2024 15:39:42
Exceltabelle daten per combobox zu word Datei
19.04.2024 14:04:05
PDF per VBA ausgeben - Seitenskalierung
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1240to1244
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
1240to1244
1240to1244
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

(noch eine) Lösung zu rekursiver Ordnersuche

(noch eine) Lösung zu rekursiver Ordnersuche
Oberschlumpf
Hallo Leute
Ich weiß, ich habe das Rad wohl auch nur noch mal neu erfunden :-), aber trotzdem möchte ich euch meine Version von rekursiver Ordnersuche vorstellen.
Wenn ich für irgendein "Projekt" Verzeichnisse + Unterverzeichnisse durchsuchen musste, schob ich diesen Programmierteil oft erst mal nach hinten, weil ich selbst nicht wusste, wie man Verzeichnisse + Unterverzeichnisse durchsucht.
Deswegen musste ich immer auf Lösungen wie
http://www.activevb.de/tipps/vb6tipps/tipp0602.html
http://www.activevb.de/tipps/vb6tipps/tipp0414.html
oder
http://www.activevb.de/tipps/vb6tipps/tipp0128.html
zurückgreifen.
(die Auswahl dieser 3 Links ist nur beispielhaft, weil es noch viele andere Links mit gleichen oder ähnlichen Lösungen gibt)
Na ja, jedenfalls mochte ich keine dieser Lösungen wirklich, weil ich immer wieder erst einlesen, verstehen + dann für meine Zwecke anpassen musste.
Ich finde den Code unübersichtlich, weil so viel.
Nun hab ich es selbst mal versucht.
Das Ergebnis könnt ihr nun sehen und testen (wer mag):
https://www.herber.de/bbs/user/78098.xls
Ich finde, im Vergleich zu den Lösungen in den vorgestellten Links ist mein Code sehr kompakt.
Mein Code ist zwar (auch) nicht schnell, aber wenn für fast 6000 Verzeichnisse nur ca. 1 Minute benötigt wird, dann ist das zumindest für mich ok.
Mein Code arbeitet mit einem Array, welches so lange gefüllt wird, bis alles durchsucht wurde.
1. Gestartet wird mein Code mit dem Makro "Ordnerauswahl"
2. Zuerst wird man aufgefordert, ein Verzeichnis - im weiteren das "Hauptverzeichnis" für den Code - auszuwählen
3. Nun werden, vom ausgewählten Verzeichnis, alle Unterverzeichnisse gesucht
4. Wenn 3. fertig, dann werden alle gefundenen Verzeichnisse im aktuellen Tabellenblatt in Spalte A aufgelistet
So, wer möchte, kann nun noch Spalte A sortieren + in einer Hilfsspalte nach doppelten Einträgen suchen.
In meinem Versuch mit den fast 6000 Unterverzeichnissen hab ich keine doppelten Einträge gefunden.
Ich würde mich freuen, wenn ihr meinen Code testet + mir Feedback gebt.
Es kann ja sein, dass ihr Fehler findet, von denen ich noch gar nicht wusste, dass es sie gibt :-)
Ciao
Thorsten
Ein Stolperstein ist die ExcelVersion ...
27.12.2011 12:30:56
Matthias
Hallo Thorsten
Hab zwar noch nicht ausgiebig getestet, aber begonnen hatte ich mit XL2000.
Da läufts leider nicht.
Fehlermeldung:
Fehler beim Kompilieren
Variable nicht definiert
markiert wird (msoFileDialogFolderPicker) Sub Ordnerauswahl() Dim strOrdner As String With Application.FileDialog(msoFileDialogFolderPicker) in Excel2007 konnte ich zumindest schonmal ein kleineres Verzeichnis auflisten.
Vielleicht solltest Du vor dem Einlesen schon im Workbook_Open die XL-Version abfragen.
Gruß Matthias
AW: Ein Stolperstein ist die ExcelVersion ...
27.12.2011 12:50:58
Oberschlumpf
Hi Matthias
Danke für deine Rückmeldung.
Tja, schade, und ich dachte, die Version ist nicht relevant.
Wenn du noch mal testen möchtest, hier eine korrigierte Datei, dieses Mal mit einer Excelversionskontrolle:
https://www.herber.de/bbs/user/78103.xls
Kann man nun "ungestörter" testen?
Ciao
Thorsten
Anzeige
Stolperstein ist teilweise aber noch da ...
27.12.2011 14:34:01
Matthias
Hi Thorsten
Ich würde die Mappe aber Schließen (bei älterer Xl-Version)
Da ein manuelles "Anstoßen" der Prozedur ja noch möglich ist
und das wiederum zum Crash führt.
aber ich teste mal step by step (das ist ja so gewünscht von Dir)
Find ich übrigens gut das Du es hier reinstellst.
Gruß Matthias
AW: Stolperstein ist teilweise aber noch da ...
27.12.2011 14:46:25
Oberschlumpf
Hi Matthias
Ja, stimmt, auch bei ungeeigneter Excel-Version ist das Makro trotzdem startbar.
Aber ich werde das automatische Schließen der Datei nicht mit einbauen.
Ich appelliere eher an den gesunden Menschenverstand.
Wer nach Hinweis auf Nichtlauffähigkeit des Makros selbiges trotzdem startet, ist selber schuld ;-)
Ciao + ich warte weiter neugierig auf deine und die Ergebnisse möglicher anderer Tester
Thorsten
Anzeige
ohne "On Error Resume Next" geht nichts bei mir...
28.12.2011 13:13:21
Matthias
Hi
Hinweis zu Case12 
Case 12
strValue = "Sie benutzen Excel 2007" & vbCrLf & "Da ich diese Version nicht besitze, konnte ich meinMakro nicht testen." & vbCrLf & "Ich weiß nicht, ob mein Makro funktioniert." & vbCrLf & "Starten Sie mein Makro über Entwicklertools/Makros"
Nur so als Idee:
Ich könnte mir dann auch noch eher ein Startbutton vorstellen (bevor der Anwender selbst suchen muß wie er das Makro startet),
Dieses Button würde ich bei älteren Versionen einfach auf .Enabled=False setzen.
Gruß Matthias
Anzeige
funktioniert ab Version Excel 2002 (10)
28.12.2011 15:27:29
Oberschlumpf
Hallo Leute
Mein anfänglicher Glaube, die Excelversion sei für meinen Lösungsvorschlag unrellevant, hat sich leider in Luft aufgelöst.
siehe
http://0711office.de/vba/FileDialog/default.htm
Hallo Matthias
aber du hast mich wieder auf den richtigen Weg gebracht ;-)
Ich hab On Error... doch eingebaut:
https://www.herber.de/bbs/user/78113.xls
Hab die Versionskontrolle aber ohne Button gelöst. Wenn Version kleiner 10, dann Hinweis + Datei zu.
Läufts denn nun?
Bei mir treten keine Fehler auf. Auch nicht auf einem Laufwerk mit 5083 Verzeichnissen + Unterverzeichnissen.
Weiter danke für dein Feedback. Ich lese gerne auch die Meinungen Anderer.
Ciao
Thorsten
Anzeige
AW: funktioniert ab Version Excel 2002 (10)
28.12.2011 15:56:02
hary
Hallo Thorsten
Hier 2007. Laeuft super durch. Keine Doppelten. Bei ca.7500.
Aber viel Muell gefunden ;-)
Danke
gruss hary
AW: funktioniert ab Version Excel 2002 (10)
28.12.2011 16:07:58
Oberschlumpf
Hi Hary
Danke für dein Feedback.
Freut mich, dass a) die Sache nun läuft (zumindest bei dir + bei mir ;-) ) und b), dass ich dir beim Aufräumen helfen konnte..hehe
Ciao
Thorsten
läufts denn nun - teilweise
28.12.2011 16:11:29
Matthias
Hallo Thorsten
Wenn ich z.B. das Windowsverzeichnis wähle, bekomme ich keinen einzigen Eintrag
Und warum schreibst Du immer ans Ende des Strings ein "\"
Du listest einmal Verzeichnisse auf
wie z.B hier:
 A
1C:\Office2000\
2C:\Office2000\Office\
3C:\Office2000\Stationery\
4C:\Office2000\Templates\
5C:\Office2000\Office\1031\
6C:\Office2000\Office\1033\
7C:\Office2000\Office\1036\
8C:\Office2000\Office\1040\
9C:\Office2000\Office\Addins\
10C:\Office2000\Office\Bitmaps\
11C:\Office2000\Office\Borders\
12C:\Office2000\Office\bots\
13C:\Office2000\Office\Broadcast\
14C:\Office2000\Office\Convert\
15C:\Office2000\Office\forms\
16C:\Office2000\Office\fpclass\
17C:\Office2000\Office\HTML\
18C:\Office2000\Office\images\
19C:\Office2000\Office\Macros\
20C:\Office2000\Office\Makro\
21C:\Office2000\Office\Queries\
22C:\Office2000\Office\Samples\
23C:\Office2000\Office\Shortcut Bar\
24C:\Office2000\Office\Startup\
25C:\Office2000\Office\tutorial\
26C:\Office2000\Office\Xlators\
27C:\Office2000\Office\XLStart\
28C:\Office2000\Stationery\1031\
29C:\Office2000\Templates\1031\
30C:\Office2000\Templates\Presentation Designs\


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
und einmal Dateien,
wie z.B. hier:
 A
1C:\XLS\
2C:\XLS\77770.xls\
3C:\XLS\77775.xls\
4C:\XLS\77777.xls\
5C:\XLS\78028.xls\
6C:\XLS\Alex.xls\
7C:\XLS\alex1.jpg\
8C:\XLS\Alex2.xls\
9C:\XLS\Alex3.xls\
10C:\XLS\Alex4mitListe.xls\
11C:\XLS\Alex5.xls\
12C:\XLS\Alifa.xls\
13C:\XLS\Andre.xls\
14C:\XLS\AnRobert.jpg\
15C:\XLS\BedForm mit Zeit.xls\
16C:\XLS\bestimmte Tabelle kopieren und positionieren.xls\
17C:\XLS\Blattregisterkarten_An_Aus_VBA.xls\
18C:\XLS\BlockKopieren.xls\
19C:\XLS\BuchstabenZaehlen.xls\


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4

Ist das so gewollt ?
Gruß Matthias
Anzeige
AW: läufts denn nun - teilweise...UPPSSS
28.12.2011 16:24:30
Oberschlumpf
Hi Matthias
Hmm...nein, gewollt ist das mit den Dateien nicht. Und wieso auch Dateien gelistet werden, weiß ich noch nicht.
Wegen deiner Frage mit dem endenden Slash:
Ersetz diese Zeile 
Range("A" & liRow).Value = lstrSubFolder(liIdx)

durch diese Zeile 
Range("A" & liRow).Value = Left(lstrSubFolder(liIdx), Len(lstrSubFolder(liIdx)) - 1)

Mich stört der Slash am Ende nicht. Deswegen hab ich ihn nicht entfernt.
Nun wieder zum Problem mit den Dateien.
Es bleibt aber weiter eins, weil ich nicht verstehe, wieso auch Dateien gelistet werden.
Ich kann bei mir jedes beliebige Verzeichnis wählen (auch ganze Laufwerke). Bei mir werden nur Verzeichnisse gelistet.
Hmm..ist vielleicht ne blöde Frage, aber kann es sein, dass deine "Dateien", z Bsp C:\XLS\77770.xls\, keine Dateien, sondern nur gleichnamige Unterverzeichnisse in C:\XLS sind, und eben darin befindet sich die Datei 77770.xls?
Anders kann ich es mir (noch) nicht erklären. Vielleicht hast du ja eine Idee.
Ciao
Thorsten
Anzeige
es sind Dateien ...
28.12.2011 16:58:57
Matthias
Hallo Thorsten
Zitat:
aber kann es sein, dass deine "Dateien", z Bsp C:\XLS\77770.xls\, keine Dateien, sondern nur gleichnamige Unterverzeichnisse in C:\XLS sind
Antwort:
Nein, es sind alles Dateien, keine Verzeichnisse.
Zitat:
Vielleicht hast du ja eine Idee.
Antwort:
Hab mich noch nicht mit dem Code auseinandergesetzt, nur getestet.
Gruß Matthias
AW: Dateien bei mir nicht
28.12.2011 19:03:58
hary
Moin
habe nochmal getestet. Bei mir werden egal was ich anstelle keine Dateien angezeigt.
gruss hary
@hary Ich benutze WIN7 64 bit XL2007 oT
28.12.2011 19:11:12
Matthias
AW:habe XP gruss owT
28.12.2011 19:15:27
hary
.
Dann spielt das BS also auch eine Rolle oT
28.12.2011 19:27:02
Matthias
AW: Stolperstein ist teilweise aber noch da ...
28.12.2011 20:11:57
Reinhard
Hallo Thorsten,
ich sehe das wie Matthias und sehe es gerne wenn hier jmd. nicht wegen einem Problem anfragt sondern eine Lösung für etwas präsentiert die wir ggfs. alle mal gerne benutzen würden.
Danke dafür.
Tests von Code sind immer aufwendig.
Z.B. wenn man eine gute Fehlerbehandlung einbauen will. Auf manche Fehlergründe kommt man gar nicht,
denn man selbst würde nie so agieren wie irgendein User.
Und das mit den Excelversionen. Jemand mit XL 2010 wird erstaunt schauen wenn das steht daß die Version unbekannt ist *grins* Ich glaube XL 2010 ist Version 14 da 13 übersprungen wurde.
Es gibt auch Office Starter, m.W. ist das Office 2010 mit eingeschränkten Funktionen und Werbeeinblendungen.
Ob das auch die Version 14.0 hat weiß ich nicht, 14.5 oder 14b wäre auch denkbar.
Und ob da dein Code läuft oder nur in komplettem XL 2010 weiß ich auch nicht.
Ggfs. Mac-Benutzer auch, da werden die Versionen annerster gezählt/benannt.
Ich habe u.a. XL 2007 und werde deinen Code testen.
Gruß
Reinhard
Anzeige
Ordner auflisten mal anders
28.12.2011 17:08:12
Anton
Hallo Thorsten,
Code:

Sub ordner_auflisten()
  Dim BrowseDir As Object, objShell As Object, objExec As Object  
  Dim strStart As String, zeile As Long, ordner    
  Set BrowseDir = CreateObject("Shell.Application").BrowseForFolder(0, "Ordner auswählen", &H0, 17)    
  If Not BrowseDir Is Nothing Then    
    zeile = 1
    strStart = BrowseDir.self.Path
    Set objShell = CreateObject("WScript.Shell")  
    ChDrive Left(strStart, 1)
    ChDir strStart
    Set objExec = objShell.Exec("cmd /c dir /s /b /a:d")
    For Each ordner In Split(objExec.StdOut.ReadAll, vbCrLf)    
      Tabelle1.Cells(zeile, 1).Value = ordner
      zeile = zeile + 1
    Next
    Set objShell = Nothing  
  End If  
  Set BrowseDir = Nothing  
End Sub  


Kleines Manko dieses Makros ist ein DOS-Fenster, aber kürzer geht es kaum :-)
mfg Anton
Anzeige
Perfekt ;o) oT
28.12.2011 17:43:33
Matthias
ohne Schleife
28.12.2011 20:30:27
Josef

Hallo Anton,
die For-Each-Schleife kann man sich auch sparen.
Sub ordner_auflisten()
  Dim BrowseDir As Object, objShell As Object, objExec As Object
  Dim strStart As String, zeile As Long, ordner, vntRet As Variant
  Set BrowseDir = CreateObject("Shell.Application").BrowseForFolder(0, "Ordner auswählen", &H0, 17)
  If Not BrowseDir Is Nothing Then
    zeile = 1
    strStart = BrowseDir.self.Path
    Set objShell = CreateObject("WScript.Shell")
    ChDrive Left(strStart, 1)
    ChDir strStart
    Set objExec = objShell.Exec("cmd /c dir /s /b /a:d")
    vntRet = Split(objExec.StdOut.ReadAll, vbCrLf)
    Tabelle1.Range("A1").Resize(UBound(vntRet) + 1, 1) = Application.Transpose(vntRet)
    Set objShell = Nothing
  End If
  Set BrowseDir = Nothing
End Sub



« Gruß Sepp »

Anzeige
AW: Ordner auflisten mal anders
28.12.2011 23:00:08
Oberschlumpf
Hi Anton
Danke auch für deinen Beitrag - und - ja, klasse, deine ist auf jeden Fall die bessere, weil augenscheinlich auch auf Win 7 64bit funktionierende Version.
Aber trotzdem "klau" ich mir ein paar deiner Lorbeeren :-) , die du natürlich auch verdient hast!
Davon ausgehend, dass eigentlich ich dich auf die Idee gebracht habe, deine Version zu entwickeln, weil meine bei Matthias ja nich so wollte, wie sie sollte, bin ich ja auch "ein wenig schuld daran", dass nun eine wahrscheinlich allgemein gültige Version "auf dem Markt ist" :-)
Na ja, sollte deine Version aber schon lange in deinem "Tool-Keller" Staub angesetzt haben, und du hast sie nur hervorgekramt, weil du schon längst wusstest, dass sie funktioniert, dann beachte nichts von dem Vorhergeschrebenen und ein paar deiner Lorbeeren will ich dann auch nicht :-)
Ciao
Thorsten
doch n kleiner Haken ;-)
29.12.2011 00:10:45
Oberschlumpf
Hi Jan
Obwohl (auch) ich immer noch von deiner Version begeistert bin, habe ich trotzdem n kleinen Haken gefunden. :-)
Wegen des Umweges über DOS werden die Umlaute + sonstige Sonderzeichen nicht richtig dargestellt.
Da ich aber dieses Problem schon mal hatte, hatte ich ne Lösung in meinem "Tool-Keller" ;-)
Ich hab mal die Version von Josef wie folgt geändert: 
Sub ordner_auflisten()
Dim BrowseDir As Object, objShell As Object, objExec As Object
Dim strStart As String, zeile As Long, ordner, vntRet As Variant
Dim liIdx As Integer
Set BrowseDir = CreateObject("Shell.Application").BrowseForFolder(0, "Ordner auswählen", &H0,  _
17)
If Not BrowseDir Is Nothing Then
zeile = 1
strStart = BrowseDir.self.Path
Set objShell = CreateObject("WScript.Shell")
ChDrive Left(strStart, 1)
ChDir strStart
Set objExec = objShell.Exec("cmd /c dir /s /b /a:d")
vntRet = Split(objExec.StdOut.ReadAll, vbCrLf)
For liIdx = LBound(vntRet) To UBound(vntRet)
vntRet(liIdx) = Replace(vntRet(liIdx), "„", "ä")
vntRet(liIdx) = Replace(vntRet(liIdx), "”", "ö")
vntRet(liIdx) = Replace(vntRet(liIdx), "", "ü")
vntRet(liIdx) = Replace(vntRet(liIdx), "á", "ß")
vntRet(liIdx) = Replace(vntRet(liIdx), "™", "Ö")
vntRet(liIdx) = Replace(vntRet(liIdx), "Ž", "Ä")
vntRet(liIdx) = Replace(vntRet(liIdx), "š", "Ü")
vntRet(liIdx) = Replace(vntRet(liIdx), "´", "'")
vntRet(liIdx) = Replace(vntRet(liIdx), "ï", "'")
Next
Tabelle1.Range("A1").Resize(UBound(vntRet) + 1, 1) = Application.Transpose(vntRet)
Set objShell = Nothing
End If
Set BrowseDir = Nothing
End Sub

Vielleicht weiß ja auch hier noch jemand, wie man vielleicht die Schleife abkürzen könnte.
Ciao
Thorsten
wieder ohne Schleife!
29.12.2011 00:23:25
Josef

Hallo Thorsten,
auch dazu braucht es keine Schleife.
Sub ordner_auflisten()
  Dim BrowseDir As Object, objShell As Object, objExec As Object
  Dim strStart As String, zeile As Long, ordner, vntRet As Variant, strTmp As String
  Set BrowseDir = CreateObject("Shell.Application").BrowseForFolder(0, "Ordner auswählen", &H0, 17)
  If Not BrowseDir Is Nothing Then
    zeile = 1
    strStart = BrowseDir.self.Path
    Set objShell = CreateObject("WScript.Shell")
    ChDrive Left(strStart, 1)
    ChDir strStart
    Set objExec = objShell.Exec("cmd /c dir /s /b /a:d")
    strTmp = objExec.StdOut.ReadAll
    
    strTmp = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(strTmp, "„", _
      "ä"), "”", "ö"), "", "ü"), "á", "ß"), "™", "Ö"), "Ž", "Ä"), "š", "Ü"), "´", "'"), "ï", "'")
    
    vntRet = Split(strTmp, vbCrLf)
    Tabelle1.Range("A1").Resize(UBound(vntRet) + 1, 1) = Application.Transpose(vntRet)
    Set objShell = Nothing
  End If
  Set BrowseDir = Nothing
End Sub



« Gruß Sepp »

AW: wieder ohne Schleife!
29.12.2011 00:29:07
Oberschlumpf
Hi Sepp
Danke!
Sieht zwar n bissi unübersichtlich aus, weil vielmals Replace verschachtelt....aber egal, ich hab ja nich nach Aussehen gefragt - meine Frage/Anregung ist also erledigt ;-)
Ciao
Thorsten

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige