Thema Datum  Von Nutzer Rating
Antwort
07.08.2023 13:32:24 Sven
Solved
07.08.2023 14:20:35 Gast49419
NotSolved
07.08.2023 15:22:44 Sven
NotSolved
Blau Ein Makro soll alle Unterordner mit einbeziehen
07.08.2023 17:50:15 Gast78637
NotSolved
07.08.2023 18:16:20 Sven
NotSolved
07.08.2023 18:34:19 Gast59948
NotSolved
08.08.2023 06:58:57 Sven
NotSolved
08.08.2023 11:16:16 Gast40343
NotSolved
14.08.2023 15:05:32 Sven
NotSolved
15.08.2023 00:03:25 Gast27989
NotSolved
15.08.2023 08:25:11 Sven
NotSolved
15.08.2023 13:24:52 Gast20621
NotSolved
15.08.2023 14:27:50 Sven
NotSolved
16.08.2023 10:01:05 Gast11842
NotSolved
16.08.2023 12:09:31 Sven
NotSolved
16.08.2023 18:39:13 Gast50512
NotSolved
06.09.2023 11:24:56 Sven
NotSolved
07.09.2023 18:03:43 Gast32657
NotSolved
08.09.2023 11:25:14 sven
NotSolved
08.09.2023 14:47:37 Gast54751
NotSolved
08.09.2023 15:05:17 Gast74933
NotSolved
08.09.2023 17:41:50 Gast28898
NotSolved
11.09.2023 07:44:00 Sven
NotSolved
11.09.2023 14:06:32 Gast56381
NotSolved
07.08.2023 17:10:58 ralf_b
Solved
07.08.2023 18:09:35 Sven
NotSolved
07.08.2023 18:12:02 ralf_b
NotSolved
07.08.2023 18:17:57 Sven
NotSolved

Ansicht des Beitrags:
Von:
Gast78637
Datum:
07.08.2023 17:50:15
Views:
246
Rating: Antwort:
  Ja
Thema:
Ein Makro soll alle Unterordner mit einbeziehen

Die Aufgabenstellung ist schon etwas umfangreicher, da wäre mein Vorschlag die ganzen Punkte sortiert in eingene Subs/Funktionen zu organisieren. Aktuell blickt ja kein Mensch mehr durch!

Grundsätzlich sollte der Einsprungspunkt kurz und knackig sein, sowas wie das hier:

Option Explicit

Public Sub Example()
  
  Dim strSelectedPath As String
  
  strSelectedPath = "C:\PP\Standort\Abteilung\Bereich\Bilder" '< bei dir kommt das durch den Auswahl-Dialog herein
  
  Dim colFiles As VBA.Collection
  If SearchFiles(strSelectedPath, colFiles) = 0 Then
    Call MsgBox("Keine Treffer.", vbExclamation)
    Exit Sub
  End If
  
  Dim vntFullFilename As Variant
  For Each vntFullFilename In colFiles
    Call HandleFile(CStr(vntFullFilename))
  Next
  
End Sub
  • SearchFiles() >> Führt die (rekursive) Suche nach den gewünschten Dateien durch und liefert das Ergebnis.
  • CheckFile() >> Enthält die Logik, welche entscheidet ob eine Datei ein Treffer ist, oder nicht.
  • HandleFile() >> Führt die notwendigen Aktion aus - z.B. Hintergrundbild setzen.

>> Wenn du aus irgendwelchen Ausdrücken störende Zeichen entfernen musst, dann sollte man diese Logik in eine Funktion z.B. NormalizeName() - oder ähnlich - packen. Der übergibst du den Unrat und sie spuckt als Ergebnis den Wert mit ersetzen Zeichen aus, mit dem man dann weiter arbeitet.

Private Sub HandleFile(FullFilename As String)
  
  ' TODO:
  If InStr(FullFilename, "thumbs.dp") = 0 Then
    '...
  End If
  
End Sub

Private Function CheckFile(FullFilename As String) As Boolean
  
  ' TODO: implement filter logic
  CheckFile = Right$(FullFilename, 4) = ".png"
  
End Function

Private Function SearchFiles(Path As String, FoundFiles As VBA.Collection) As Long
  
  If FoundFiles Is Nothing Then
    Set FoundFiles = New VBA.Collection
  End If
  
  Dim strPath As String
  Dim strFilename As String
  
  strPath = IIf(Right$(Path, 1) <> "\", Path & "\", Path)
  
  On Error GoTo ErrHandler
  strFilename = Dir$(strPath, vbDirectory)
  On Error GoTo 0
  
  Dim fileAttr As VbFileAttribute
  Dim colDirectories As VBA.Collection
  Set colDirectories = New VBA.Collection
  
  Do While strFilename <> vbNullString
    
    On Error GoTo ErrHandler
    fileAttr = -1
    fileAttr = GetAttr(strPath & strFilename)
    On Error GoTo 0
    
    If (fileAttr And vbDirectory) = vbDirectory And Not (fileAttr And vbSystem) = vbSystem Then
      If strFilename = "." Or strFilename = ".." Then
        GoTo Continue_Do
      End If
      Call colDirectories.Add(strPath & strFilename)
      
    ElseIf (fileAttr And vbNormal) = vbNormal And Not (fileAttr And vbSystem) = vbSystem Then
      If CheckFile(strPath & strFilename) Then
        Call FoundFiles.Add(strPath & strFilename)
      End If
      
    End If
    
Continue_Do:
    strFilename = Dir$()
  Loop
  
  DoEvents
  Dim vntDirectory As Variant
  For Each vntDirectory In colDirectories
    Call SearchFiles(CStr(vntDirectory), FoundFiles)
  Next
  
  SearchFiles = FoundFiles.Count
  
Exit Function
ErrHandler:
  'TODO: implement proper logging
  Debug.Print Format$(Now, "yyyy-mm-dd"); Tab(12); "'"; Err.Source; "'"; _
              Tab(2); "Path: '"; strPath & strFilename; "'"; _
              Tab(4); "=> '"; Err.Description; "'"
  Resume Next
End Function

Auf diese Weise kannst du später auch das ganze recht unkompliziert erweitern - z.B. wenn solch eine Suche länger dauern sollte, ein Provider, welcher in Excel den Fortschritt in der Statusleiste aktualisiert.

 

Grüße

PS: Die angedeutete if in HandleFile() gehört eigentlich auch in CheckFile(), denn das ist Teil der Validierung, also der Fragestellung, ob die gerade betrachtete Datei ein Treffer ist, oder nicht.

Die if steht dort also nur, damit du einen Orientierungspunkt zu deinem Code hast. Da gehört also eigentlich das hinein was in der if drin steht.


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
07.08.2023 13:32:24 Sven
Solved
07.08.2023 14:20:35 Gast49419
NotSolved
07.08.2023 15:22:44 Sven
NotSolved
Blau Ein Makro soll alle Unterordner mit einbeziehen
07.08.2023 17:50:15 Gast78637
NotSolved
07.08.2023 18:16:20 Sven
NotSolved
07.08.2023 18:34:19 Gast59948
NotSolved
08.08.2023 06:58:57 Sven
NotSolved
08.08.2023 11:16:16 Gast40343
NotSolved
14.08.2023 15:05:32 Sven
NotSolved
15.08.2023 00:03:25 Gast27989
NotSolved
15.08.2023 08:25:11 Sven
NotSolved
15.08.2023 13:24:52 Gast20621
NotSolved
15.08.2023 14:27:50 Sven
NotSolved
16.08.2023 10:01:05 Gast11842
NotSolved
16.08.2023 12:09:31 Sven
NotSolved
16.08.2023 18:39:13 Gast50512
NotSolved
06.09.2023 11:24:56 Sven
NotSolved
07.09.2023 18:03:43 Gast32657
NotSolved
08.09.2023 11:25:14 sven
NotSolved
08.09.2023 14:47:37 Gast54751
NotSolved
08.09.2023 15:05:17 Gast74933
NotSolved
08.09.2023 17:41:50 Gast28898
NotSolved
11.09.2023 07:44:00 Sven
NotSolved
11.09.2023 14:06:32 Gast56381
NotSolved
07.08.2023 17:10:58 ralf_b
Solved
07.08.2023 18:09:35 Sven
NotSolved
07.08.2023 18:12:02 ralf_b
NotSolved
07.08.2023 18:17:57 Sven
NotSolved