omochka
Goto Top

Ordner durchsuchen und Treffer als Liste ausgeben (Excel)

Hallo!

Ich möchte durch klicken auf ein Objekt bzw. Button einen Ordner nach einer zuvor eingegebenen Nummer durchsuchen und mir das Ergebnis als Liste (nicht Excel-Liste, sondern UserForm) ausgeben lassen. Diese Liste soll als PopUp erscheinen. Wenn ich ein Ergebnis anklicke, wird die entsprechende Datei mit dem entsprechendem Programm geöffnet.

Kann mir einer helfen?

0c9326df99db8706bd603f9064ec7cd8-testuw3

Content-Key: 79848

Url: https://administrator.de/contentid/79848

Ausgedruckt am: 29.03.2024 um 08:03 Uhr

Mitglied: bastla
bastla 07.02.2008 um 18:23:59 Uhr
Goto Top
Hallo omochka!

Du benötigst

- Schaltfläche (in der Tabelle) "btnShowAll", Caption: "Alle zeigen", Code (die zu suchende Nummer wird in diesem Beispiel aus Zelle C5 entnommen):
Private Sub btnShowAll_Click()
Datei = Dir(Fld & "\" & "*" & [C5] & "*.*")  
frmOpenFile.lstFiles.Clear
Do While Datei <> ""  
    frmOpenFile.lstFiles.AddItem Datei
    Datei = Dir
Loop
frmOpenFile.Show
End Sub

- UserForm "frmOpenFile", Caption und weitere Gestaltung nach Wunsch, mit
- ListBox "lstFiles" und
- CommandButton "btnClose", Caption "Schließen"
- Code:
Private Sub btnClose_Click()
Me.Hide
End Sub

Private Sub lstFiles_Click()
ShellExecute hWnd, "open", Fld & "\" & lstFiles.Text, "", "", SW_NORMAL  
End Sub

- ein Modul mit folgendem Code:
Public Const Fld As String = "D:\Dein Ordner" 'ohne abschließenden "\", auch nicht bei Root (daher nicht "D:\", sondern nur "D:")  

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _  
 (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
  ByVal lpParameters As String, ByVal lpDirectory As String, _
  ByVal nshowcmd As Long) As Long

Const SW_HIDE = 0                  ' Versteckt öffnen  
Const SW_MAXIMIZE = 3              ' Maximiert öffnen  
Const SW_MINIMIZE = 6              ' Minimiert öffnen  
Const SW_NORMAL = 1
Const SW_RESTORE = 9
Const SW_SHOWMAXIMIZED = 3
Const SW_SHOWMINIMIZED = 2
Const SW_SHOWMINNOACTIVE = 7
Const SW_SHOWNOACTIVATE = 4

Gutes Gelingen!

Grüße
bastla

[Edit] Löschen der Dateiliste im ersten Sub ergänzt. [/Edit]
Mitglied: omochka
omochka 08.02.2008 um 15:17:26 Uhr
Goto Top
Wow! Vielen-vielen Dank! Hätte nicht gedacht, dass mir einer helfen kann. face-smile

Eine Frage habe ich noch: Was ändert sich am Code, wenn auch noch die Unterordner des Stammordners durchsucht werden sollen? Bzw. ein Ordner, wenn es einen Ordner mit der gleichen Nummer gibt, dann soll er auch durchsucht werden.
Mitglied: bastla
bastla 08.02.2008 um 15:42:36 Uhr
Goto Top
Hallo omochka!

Wenn der Ordnernamen mit der Nummer übereinstimmt, ginge es so:
Private Sub btnShowAll_Click()
Datei = Dir(Fld & "\" & "*" & [C5] & "*.*")  
frmOpenFile.lstFiles.Clear
Do While Datei <> ""  
    frmOpenFile.lstFiles.AddItem Datei
    Datei = Dir
Loop
Datei = Dir(Fld & "\" & [C5] & "\*.*")  
Do While Datei <> ""  
    frmOpenFile.lstFiles.AddItem [C5] & "\" & Datei  
    Datei = Dir
Loop
frmOpenFile.Show
End Sub
Soferne auch für den Ordner gilt, dass die gesuchte Nummer nur Namensbestandteil ist, oder, dass auch noch Unterordner des Ordners einbezogen werden müssten, wäre eine Suche über das "FileSystemObject" zu überlegen.

Übrigens noch ein Nachtrag (hier im Code bereits berücksichtigt): Die Liste muss mit
frmOpenFile.lstFiles.Clear
vor dem Befüllen gelöscht werden, da sich ansonsten noch die vorher gefundenen Einträge darin befinden. Ich trage das auch in dem in meinem vorigen Beitrag geposteten Code nach.

Grüße
bastla
Mitglied: omochka
omochka 08.02.2008 um 16:39:43 Uhr
Goto Top
Vielen Dank! Ich probiere es gleich aus. Wenn man beim Schließen der Liste "Unload Me" ausführt, dann werden die Einträge ebenfalls gelöscht. face-smile
Mitglied: bastla
bastla 08.02.2008 um 16:46:31 Uhr
Goto Top
Hallo omochka!

Mit "Unload" hast Du natürlich recht, und bei diesem einfachen Formular bringt es vermutlich ohnehin nicht viel, es geladen zu lassen und nur zu "hide"en.

Grüße
bastla
Mitglied: omochka
omochka 08.02.2008 um 17:29:30 Uhr
Goto Top
Funktioniert super, bastla! Vielen Dank! face-smile

Wenn du Glück hast, dann werde ich noch eine weitere Frage stellen. Ich versuche es allerdings erst selber. :D
Mitglied: omochka
omochka 08.02.2008 um 17:38:01 Uhr
Goto Top
Ne, das würde zu lange dauern, wenn ich es selbst versuche. face-smile
Ich möchte nun alle Dateien im Ordner mit der gegebenen Nummer anzeigen lassen, sogar, wenn sich diese in Unterordnern befinden. Kannst du mir noch mal helfen, bastla? face-smile
Mitglied: bastla
bastla 08.02.2008 um 17:45:32 Uhr
Goto Top
Hallo omochka!

Betrifft dies nur eine (Unter-)Ordnerebene, oder muss noch tiefer gegraben werden?

Zusatzfrage: Lassen sich Dateien und Ordner dadurch unterscheiden, dass nur Dateien einen Typ haben (bzw alle Ordnernamen keinen Punkt enthalten)?

Grüße
bastla
Mitglied: omochka
omochka 08.02.2008 um 18:10:59 Uhr
Goto Top
Hallo bastla!

Es muss tiefer gegraben werden bis es keine Ordner mehr gibt.
Ordner habe keine Punkte. face-smile

MfG
omochka
Mitglied: bastla
bastla 09.02.2008 um 17:52:37 Uhr
Goto Top
Hallo omochka!

Dann starten wir das Ganze eben so:
Private Sub btnShowAll_Click()
'Zugriff über das VBScript-"FileSystemObject", daher das Object erzeugen  
Set objFS = CreateObject("Scripting.FilesystemObject")  

'Liste löschen  
frmOpenFile.lstFiles.Clear

'Durchsuchen des Ordnerbaumes starten  
DoFolders objFS.GetFolder(Fld) 'Startordner als Objekt übergeben  

'Dateiliste fertig, UserForm anzeigen  
frmOpenFile.Show
End Sub


Sub DoFolders(Folder As Object)
Dim Subfolder As Object

If LCase(Folder.Name) <> LCase("System Volume Information") Then 'nur zur Sicherheit ...  
    For Each File In Folder.Files 'Reihenfolge in der Ordnerstruktur von "oben" nach "unten", daher zunächst die Dateien ...  
        If InStr(1, File.Name, [C5], vbTextCompare) Then 'Suchkriterium im Dateinamen (allerdings inkl. Extension) enthalten?  
            frmOpenFile.lstFiles.AddItem Replace(File.Path, Fld & "\", "") 'relativen Pfad verwenden  
        End If
    Next

    For Each Subfolder In Folder.SubFolders ... und jetzt erst die Unterordner
        DoFolders Subfolder 'Rekursiver Aufruf des Sub für Unterordner  
    Next
End If
End Sub
Da der relative Pfad verwendet werden soll, muss sichergestellt sein, dass die Angabe des Startordners in der Konstanten "Fld" keinen abschließenden "\" enthält - bitte bei der Deklaration der Konstanten berücksichtigen (oder, umgekehrt, dafür sorgen, dass "Fld" mit einem "\" endet und hier im Code das Anfügen des "\" weglassen).

Grüße
bastla
Mitglied: omochka
omochka 11.02.2008 um 18:53:24 Uhr
Goto Top
Leider bekomme ich keine Ergebnisse, da sich mein Rechner mit dieser Lösung immer aufhängt. Hm.
Mitglied: bastla
bastla 11.02.2008 um 19:08:46 Uhr
Goto Top
Hallo omochka!

Da ist mir leider ein Kommentarzeichen in der Zeile "For Each Subfolder ..." abhanden gekommen (beim Posten noch schnell verschlimmbessert face-sad) - richtig wäre:
For Each Subfolder In Folder.SubFolders '... und jetzt erst die Unterordner  

Ansonsten klappts bei mir mit dem geposteten Code.

Grüße
bastla
Mitglied: omochka
omochka 11.02.2008 um 19:35:57 Uhr
Goto Top
Das habe ich gemerkt, weil dieser Bereich des Codes rot eingefärbt war. Das Zeichen habe ich gesetzt, trotzdem. Ich werde es noch mal probieren.
Mitglied: bastla
bastla 11.02.2008 um 19:55:01 Uhr
Goto Top
Hallo omochka!

Du könntest nach "If LCase ..." ein
Debug.Print Folder.Name
einbauen (und ev auch auf die nächste Zeile einen Breakpoint setzen) - wenn Du jetzt direkt aus dem VBA-Editor startest (und mit Strg-G vorher das "Direktfenster" einblendest), siehst Du zumindest einmal, welcher Ordner zuletzt durchsucht wurde ...

Grüße
bastla