strSuch = "DO("
 
For i = 0 To 100
 
If Dir("...Pfad\Dateiname" & i & ".txt") <> "" Then
 
    Open "...Pfad\Dateiname" & i & ".txt" For Input As #1
 
        Do Until EOF(1)
        Line Input #1, strTxt
            If InStr(strTxt, strSuch) > 0 Then
                inttemp1 = InStr(strTxt, strSuch)
                intZeile = Cells(Rows.Count, 1).End(xlUp).Row
                intZeileCount = intZeile + 1
                strDateiname = Mid("...Pfad\Dateiname" & i & ".txt", 27, 12)
                Cells(intZeileCount, 1) = strDateiname
                Cells(intZeileCount, 2) = Mid(strTxt, inttemp1, 7)
            End If
        Loop
    Close 1
 
End If
 
Next i