VBA: mehrere Dateien nacheinander einlesen

Sub Fertigmelden(JOBNUM)
Dim strFile As String
Dim JOBNUMMER As String
Dim DATUM As String
Dim ZEIT As String
Dim PROGRAMMIERER As String
Dim TEILENAME As String
Dim AUFTRAGSNUMMER As String
Dim POS As String
Dim BEMERKUNG As String
Dim rcount As Long
Dim fso As Object, TextDat As Object
strPath = "W:\u\SFA\JOBDATA\" & JOBNUM & "\PLAT_?"
strExt = "*.DAT"
If strPath = "" Then
Exit Sub
Else
rcount = 4
strFile = Dir(strPath & strExt)
Do While Len(strFile) > 0
Set fso = CreateObject("Scripting.FileSystemObject")
Set TextDat = fso.OpenTextFile(strFile, 1, False)
Do While TextDat.AtEndOfStream  True
Text = TextDat.ReadLine
If Mid(Text, 2, 11) = "JOB_DATA_1 " Then
JOBNUMMER = Mid(Text, 25, 5)
Cells(2, 1) = JOBNUMMER
End If
If Mid(Text, 2, 4) = "DATE" Then
DATUM = Mid(Text, 25, 10)
Cells(2, 2) = DATUM
End If
If Mid(Text, 2, 4) = "TIME" Then
ZEIT = Mid(Text, 25, 5)
Cells(2, 3) = ZEIT
End If
If Mid(Text, 2, 4) = "USER" Then
PROGRAMMIERER = Mid(Text, 25, 30)
Cells(2, 4) = PROGRAMMIERER
End If
If Mid(Text, 2, 15) = "PLATE_PART_NAME" Then
TEILENAME = Mid(Text, 25, 45)
Cells(rcount, 1) = TEILENAME
End If
If Mid(Text, 2, 16) = "PLATE_PART_ORDER" Then
AUFTRAGSNUMMER = Mid(Text, 25, 5)
Cells(rcount, 2) = AUFTRAGSNUMMER
End If
If Mid(Text, 2, 19) = "PLATE_PART_POSITION" Then
POS = Mid(Text, 25, 5)
Cells(rcount, 3) = POS
End If
If Mid(Text, 2, 18) = "PLATE_PART_REMARK " Then
BEMERKUNG = Mid(Text, 25, 40)
Cells(rcount, 4) = BEMERKUNG
rcount = rcount + 1
End If
Loop
MsgBox (strFile)
'            Workbooks(strFile).Close
TextDat.Close
strFile = Dir() ' nächste Datei
Loop
End If
End Sub