Ordner und Unterordner nach JPG auslesen

[snb]

Schau mal : https://www.clever-excel-forum.de/Thread...#pid307533
Letzte Zeile.
Besser als 100% geeignet kann ein Instrument nicht sein.

Für ein directory ohne "jpg" Dateien prüft dir() nur einmal ob diese Directory en jpg-Datei enthält und prüft nicht alle Dateien im Directory. 
Das sind wesentlich weniger Prüfungen als 'for each it in .files' für alle Directories.

[knobbi38]

Es bleibt dir unbenommen weiterhin Dir() zu verwenden. 
Wenn Performance ein Thema sein sollte, kann man auch die API Funktionen dafür verwenden.  

Knobbi38

[Gast 123]

Hallo an alle

Danke für eure Tipps, einiges war für mich neu, ein paar Tipps muss ich noch testen.
Eine FSO Datei habe ich auch, erinnere mich leider nicht welche Version schneller ist?
Im Prinzip geht es darum auch ALLE Unterordner im Ordner auszulesen
.
Diese Funktion ist in meinem bisherigen Code gegeben. Mit einigen persönlichen Varianten.
Mein Code überspringt System Ordner wie "System Volume Information" und "RECYCLE"
HTML Ordner werden NUR als Ordner gelistet, nicht der ganze Inhalt mit U-Ordnern!

mfg Gast 123

[schauan]

Hallöchen,

die API-Variante sollte die schnellste sein, fso die langsamste. Hängt auch damit zusammen, dass die API direkt das System anzapft, währenddem fso über den "objektiven" Umweg geht.

[volti]

Hallo,

ist bei der hier schon mehrfach angesprochenen API-Version die am Anfang vorgeschlagene EnumDirTreeW-Function gemeint?

Im bei mir gerade aktuell eingesetztem Tool werden ca. 20.000 Dateien vom LW "D:" in 800 ms auf Tabellenblatt aufgelistet.

Gruß
KH

[knobbi38]

Hallo,

diese hatte ich zwar nicht auf dem Schirm, geht natürlich auch. Allerdings werden meines Wissen wohl keine Platzhalter unterstützt. Mit Filter() könnte man aber dann die Ergebnismenge eingrenzen.
Ich dachte da eher an FindFirstFileEx und FindNextFileEx, welche auch mit Platzhaltern umgehen können.

Gruß
Knobbi38

[volti]

Hallo Knobbi,

natürlich werden hier auch Platzhalter unterstützt. * ist meist schon ausreichend, um rasch eine Eingrenzung zu machen.
Zu mindestens für eine einfache Eingrenzung nach Dateiname. 

i = DateiListe(ThisWorkbook.Path, "A?n*.jp*")        ' Dateien ermitteln

Aber wie ich eben testen konnte, wird auch das ? genommen.

Ansonsten könnte man, wenn es notwendig wäre, im CallBack die gerade behandelte Datei mit etwas weiterem code checken und ggf. nicht ins Array aufnehmen also ausfiltern.

PS: Öäü sind auch dabei.. 

Gruß
KH

[knobbi38]

Hallo, 

mit den Platzhaltern wusste ich nicht.  

Könntest du ein ähnliches Beispiel machen, wie in #25? 

VG
Knobbi38

[volti]

Hallo,

nach Kurzanalyse sehe ich nur eine Einschränkung nach Begriffen (Erweiterungen) in Oder-Form.

Im u.a. Beispiel habe ich das auch mal entsprechend umgesetzt.

Man kann da jetzt beliebig viele Dateiendungen oder Dateinamenteile vorgeben.
Da die Funktion aber schon selbst eine Filtermöglichkeit mitbringt, könnte diese zum Vorfiltern benutzt werden, den je mehr code desto mehr Zeit und was schon ausgefiltert wurde, braucht auch nicht nochmal geprüft werden.

In dieser Version habe ich mal die Funktion zur Prüfung der Datenlänge weggelassen. Es wird auf vbNullChar geprüft. Ist ja in Windows meistens leider so, dass man eine Variable mit ausreichend Platz reservieren muss und dann hinterher den nicht genutzten Teil abschneiden muss.

PS: Es ist nur ein Vorschlag von vielen. Ich will hier nichts verkaufen. Jeder kann nutzen was er möchte und was schneller ist, habe ich auch nicht getestet.

Code:

Option Compare Text
Private Declare PtrSafe Function EnumDirTreeW Lib "Dbghelp.dll" ( _
                ByVal hProcess As LongPtr, ByVal RootPath As LongPtr, _
                ByVal InputPathName As LongPtr, ByVal OutputPathBuffer As LongPtr, _
                ByVal cb As LongPtr, ByVal data As LongPtr) As Long
Private Declare PtrSafe Function lstrcpyW Lib "kernel32.dll" ( _
                ByVal lpString1 As LongPtr, ByVal lpString2 As LongPtr) As Long
Dim msArrFiles() As String, msArrMask() As String

Private Function DateiListe(sPfad As String, Optional sDir As String = "*", Optional sMask As String = "*") As Long
' Füllt ein Array mit den Dateipfadnamen
  ReDim msArrFiles(0)                           ' Dateiarray zurücksetzen
  
  msArrMask = Split(sMask, ";")
  EnumDirTreeW 0, StrPtr(sPfad), StrPtr(sDir), 0, AddressOf CB_EnumDirTreeProc, 0
  DateiListe = UBound(msArrFiles) - 1           ' Anzahl gefundener Dateien zurückgeben

End Function

Private Function CB_EnumDirTreeProc(ByVal lpcwStr As LongPtr, ByVal iNone As LongPtr) As Boolean
  Dim i As Long, s As String

  s = Space(500): lstrcpyW StrPtr(s), lpcwStr   ' String umkopieren
  For i = 0 To UBound(msArrMask)                ' Auf Einschränkungen prüfen
      If s Like msArrMask(i) & Chr(0) & "*" Then
         msArrFiles(UBound(msArrFiles)) = Left$(s, InStr(s, vbNullChar) - 1)
         ReDim Preserve msArrFiles(UBound(msArrFiles) + 1)
      End If
  Next i
End Function

'
' ##### Aufruftest #####
Public Sub Dateien_auflisten()
  Dim i As Long

  i = DateiListe(ThisWorkbook.Path, "A*", "*.jpeg;*.png;*.jpg")       ' Dateien ermitteln
  If i < 1 Then
     MsgBox "Habe keine Dateien gefunden!", vbCritical, "Dateien auflisten"
  Else
     ActiveSheet.Cells.Clear
     ActiveSheet.Cells(1, 1).Resize(i + 1, 1) = WorksheetFunction.Transpose(msArrFiles)
     MsgBox "Habe " & i & " Dateien gefunden!", vbExclamation, "Dateien auflisten"
  End If
End Sub

_________
viele Grüße
Karl-Heinz