Hallo,

als VBA-Neuling habe ich mir mein Script mit Hilfe von verschiedenen Forumsbeiträgen zusammengebaut.

Es hat auch schon funktioniert, aber nach Rechnerneustart geht nichts mehr.

Es scheint, als ob die Funktion .ReadLine nicht tut was sie soll.

Zur Aufgabe:

Es sollen alle .DAT Files (das sind ASCII-Files) eines Ordners, die den gleichen Namensanfang haben, nacheinander eingelesen werden.

Anschliessend wird Zeile für Zeile nach bestimmten Inhalten durchsucht und bei Übereinstimmung in das Excel-Sheet geschrieben.

Eigentlich ganz einfach, aber irgendetwas stimmt nicht und nach stundenlangem Suchen und Herumprobieren weiss ich langsam keinen Rat mehr.

Müssen etwa für diese Scripting-Methode noch bestimmte Verweise in VBA aktiviert werden?

Bitte dringend um Hilfe!

Besten Dank schon mal im Voraus

Gruß

Heiko

Sub READJOB(JOBNUM As String)
'
  Dim strPath As String
  Dim strName As String
  Dim strExt As String
  Dim strFile As String
  Dim TEXT 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 Zeile As Integer
  Dim fso As Object
  Dim TextDat As Object
'
'    RANGE("A2:D2").Value = ""
'    RANGE("A4:D500").Value = ""
'
    strPath = "W:\u\SFA\JOBDATA\" & JOBNUM & "\"
    strName = "PLAT_"
    strExt = "*.DAT"
    strFile = Dir(strPath & strName & strExt)
'
    On Error Resume Next
'
    If strPath = "" Then
      Exit Sub
    Else
'
'
        Zeile = 4
'
'
      Do While Len(strFile) > 0
'
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set TextDat = fso.OpenTextFile(strFile, 1, 0)
'
        With TextDat
          Do While Not .AtEndOfStream
          TEXT = .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(Zeile, 1) = TEILENAME
          End If
'
          If Mid(TEXT, 2, 16) = "PLATE_PART_ORDER" Then
            AUFTRAGSNUMMER = Mid(TEXT, 25, 5)
            Cells(Zeile, 2) = AUFTRAGSNUMMER
          End If
'
          If Mid(TEXT, 2, 19) = "PLATE_PART_POSITION" Then
            POS = Mid(TEXT, 25, 5)
            Cells(Zeile, 3) = POS
          End If
'
          If Mid(TEXT, 2, 18) = "PLATE_PART_REMARK " Then
            BEMERKUNG = Mid(TEXT, 25, 40)
            Cells(Zeile, 4) = BEMERKUNG
            Zeile = Zeile + 1
          End If
        Loop
      End With
'
        strFile = Dir() ' nächste Datei
      Loop
    End If

End Sub