Hallo zusammen.

Das obere Makro funktioniert soweit, aber bei dem unteren habe ich  das Problem das es nicht die Textdateien öffnet und durchsucht. Es findet glaube ich keine Textdatei in dem Pfad obwohl da 2 Stück drin sind.

Was mach ich falsch??

Gruß Chris

Danke schonmal.

Private Sub CommandButton1_Click()

    Range("F4").Select
    Selection.Interior.ColorIndex = xlNone

    Range("D2:D200").Select
    Selection.Interior.ColorIndex = 15

    Range("B2:B1000").Select
    Selection.TextToColumns Destination:=Range("B2:B1000"), DataType:=xlFixedWidth, _
    FieldInfo:=Array(Array(0, 1), Array(7, 1), Array(11, 1), Array(19, 1))

  
  
   Dim anz As Integer
   Dim zeile
  
   For a = 2 To 100
  
  
   If Cells(a, 4) = "" Then
   Exit For
   End If
  

Call Test
   
  
               
        If InStr(zeile, Cells(a, 2).Value) > 0 And InStr(zeile, Cells(a, 4).Value) > 0 And InStr(zeile, "PASS") > 0 Then Cells(a, 4).Interior.ColorIndex = 4  'Zellen grün einfärben
        If InStr(zeile, Cells(a, 2).Value) > 0 And InStr(zeile, Cells(a, 4).Value) > 0 And InStr(zeile, "FAIL") > 0 Then Cells(a, 4).Interior.ColorIndex = 3  'Zellen rot einfärben
        If InStr(zeile, Cells(a, 2).Value) > 0 And InStr(zeile, Cells(a, 4).Value) > 0 And InStr(zeile, "PASS") > 0 Then anz = anz + 1                        'Suche nach Sachnummer und Seriennummer und PASS
       
         
       Next a
   
    Cells(6, 6) = anz 'Ausgabe in Zelle
    If Cells(6, 6) = "" Then
    Cells(6, 7) = "Nichts gefunden"
    Else
    Cells(6, 7) = "gefunden"
    End If

    MsgBox "Es wurden " & anz & " gefunden"

End Sub

 
Sub Test()
Dim Liste As Variant, i As Integer
Liste = DateienListe("c:\Dokumente und Einstellungen\Desktop\2011-10-20", "*.txt")
 
If Not IsArray(Liste) Then Exit Sub
 
For i = LBound(Liste) To UBound(Liste)
    Cells(i, 1) = Liste(i)
Next i
End Sub
 
 
'- - - - - - - - - - - - - - - - - - - - - - - - - - - -
'alle Dateien eines Ordners in einem Array ausgeben
'- - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Function DateienListe(ByVal Path As String, _
                              ByVal SuchString As String) As Variant
    Dim Ordner As Object, Datei As Object
    Dim Arr() As Variant, i As Integer
    On Error GoTo Ende
    
    If Right(Path, 1) <> "\" Then Path = Path & "\"
    
    Set Ordner = CreateObject("Scripting.FileSystemObject").GetFolder(Path)
    If Ordner.Files.Count = 0 Then GoTo Ende
  
    For Each Datei In Ordner.Files
        If Datei.Name Like SuchString Then
            i = i + 1
            ReDim Preserve Arr(1 To i)
            Arr(i) = Datei.Name
        End If
    Next
 
    If i > 0 Then DateienListe = Arr
Ende:
Set Datei = Nothing: Set Ordner = Nothing
End Function