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
|