Thema Datum  Von Nutzer Rating
Antwort
29.09.2022 13:31:08 Jens
NotSolved
Blau Beispiel
29.09.2022 17:16:06 Gast60475
NotSolved

Ansicht des Beitrags:
Von:
Gast60475
Datum:
29.09.2022 17:16:06
Views:
272
Rating: Antwort:
  Ja
Thema:
Beispiel

Ich kitzel mal deine Muse mit einem Beispiel - rein mit VBA-Mitteln / ohne FileSystemObject.

Option Explicit

Public Sub OrderAuflisten()
  
  Dim rngAnchor As Excel.Range
  Dim vntFolders As Variant
  Dim vntFolder As Variant
  
  'Zelle als Ausgangspunkt für Daten
  Range("A1").Value = "Verzeichnis"
  Range("A1").Font.Bold = True
  Set rngAnchor = Range("A2")
  
  'Verzeichnisse ermitteln
  vntFolders = GetFolders("X:\Scripts")
  
  If UBound(vntFolders) <= 0 Then
    Call MsgBox("Keine Verzeichnisse gefunden.", vbExclamation)
    Exit Sub
  End If
  
  'Verzeichnisse in Excel auflisten
  rngAnchor.Resize(RowSize:=UBound(vntFolders) + 1).Value = WorksheetFunction.Transpose(vntFolders)
  
  'Verzeichnisse auf Datei(en) überprüfen
  Dim strFilename As String
  Dim iFolder As Long 'Zeilen-Offset, Verzeichnis
  Dim nValid As Long  'Anzahl valider Dateinamen in einem Verzeichnis
  
  For Each vntFolder In vntFolders
    
    'Reset
    nValid = 0
    
    'auf 1. Datei prüfen
    'Suche nach Dateien deren Name mit "scan_v2.ps1" endet
    If ValidateFileName("*scan_v2.ps1", CStr(vntFolder), strFilename) Then
      
      Debug.Print ">> '"; strFilename; "'" & "in "; vntFolder
      
      'die erste Zelle rechts, in der Zeile vom betrachteten Verzeichnis, grün färben
      rngAnchor.Offset(iFolder, 1).Interior.Color = rgbGreen
'      'alternativ (ergibt selbe Zelle)
'      rngAnchor.Worksheet.Cells(rngAnchor.Row, "B").Interior.Color = rgbGreen
      
      nValid = nValid + 1
    End If
    
'    'auf 2. Datei prüfen
'    If ValidateFileName(...) Then
'      '...
'      nValid = nValid + 1
'    End If
'
'    'auf 3. Datei prüfen
'    If ValidateFileName(...) Then
'      '...
'      nValid = nValid + 1
'    End If
'
'    'auf 4. Datei prüfen
'    If ValidateFileName(...) Then
'      '...
'      nValid = nValid + 1
'    End If
    
    'alle 4 Dateien vorhanden/gefunden?
    If nValid = 4 Then
      '-> 5. Feld grün markieren
    End If
    
    iFolder = iFolder + 1
  Next
  
  Call MsgBox("Vorgang abgeschlossen.", vbInformation)
  
End Sub

'HILFSFUNKTION:
' Liefert ein Array mit Unterverzeichnisse in 'Folder'.
Public Function GetFolders(Folder As String) As Variant
  
  Dim strRoot As String
  If Right$(Folder, 1) <> "\" Then
    strRoot = Folder & "\"
  Else
    strRoot = Folder
  End If
  
  Dim strFolder As String
  ReDim vntFolders(0 To 9) As Variant
  Dim i As Long
  
  strFolder = Dir$(strRoot, vbDirectory)
  Do Until strFolder = ""
    
    If strFolder = "." Or strFolder = ".." Then
      GoTo continue_do
    End If
    
    If (GetAttr(strRoot & strFolder) And vbDirectory) <> vbDirectory Then
      GoTo continue_do
    End If
    
    If i > UBound(vntFolders) Then
      ReDim Preserve vntFolders(0 To UBound(vntFolders) * 2.5)
    End If
    
    vntFolders(i) = strRoot & strFolder
    i = i + 1
    
continue_do:
    strFolder = Dir$(, vbDirectory)
  Loop
  
  'Was gefunden?
  If i > 0 Then
    'Array auf gefundene Ergebnisse reduzieren
    ReDim Preserve vntFolders(0 To i - 1)
    GetFolders = vntFolders
    Exit Function
  End If
  
  'leeres Array
  GetFolders = Split(Empty)
  
End Function

'HILFSFUNKTION:
' Überprüft ob in 'Folder' eine Datei existiert welche 'Pattern' entspricht.
' - Pattern unterstützt einfache Wildcards
Public Function ValidateFileName(Pattern As String, Folder As String, Optional Filename As String) As Boolean
  
  Dim strFolder As String
  Dim strFilename As String
  
  If Right$(Folder, 1) <> "\" Then
    strFolder = Folder & "\"
  Else
    strFolder = Folder
  End If
  
  'einfachste Form der Dateinamen-Validierung (Beispiel)
  ' - Zugriffsrechte vorrausgesetzt
  strFilename = Dir$(strFolder & Pattern)
  If strFilename = "" Then
    'ValidateFileName = False
    Exit Function
  End If
  
  'Ergebnis zurückgeben
  Filename = strFilename
  ValidateFileName = True
  
End Function

 


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
29.09.2022 13:31:08 Jens
NotSolved
Blau Beispiel
29.09.2022 17:16:06 Gast60475
NotSolved