Guten Abend kommunity

Habe einen Laufzeitfehler bei meiner VBA Programierung.

Kann mir jemand dabei helfen den Fehler zu suchen?

Irrgend wie komme ich nicht weiter ..........

Public Static Sub CncOut()

On Error GoTo Fehler

  If Sheets("CNC Programm").Range("V8").Value = "" Then
    MsgBox "Bitte geben Sie eine gültige Auftragsbezeichnung ein.", vbInformation
    Exit Sub
  End If

  Dim Zeile As Long
  Dim DateiNameInput As String
  Dim DateiNameOutput As String
  Dim Laenge As Double
  Dim Breite As Double
  Dim Dicke As Double
  Dim Bandseite As Double
  Dim Schwelle As Double
  Dim Rahmenfasen As Double
  Dim Rokustrip As Double
  Dim Kappen As Double
  Dim Rahmenbreite_Bandseite As Double
  Dim Rahmenbreite_Schliessblechseite As Double
  Dim Rahmenbreite_oben As Double
  Dim Schliessblechposition As Double
  Dim Falztiefe As Double
  Dim Falzhöhe As Double
  Dim Schliesblechtyp As Double
  Dim Drückerhöhe As Double
  Dim Türluftoben As Double
  Dim Bodenluft As Double
  Dim Türblatlänge As Double
  Dim Bandtyp As Double
  Dim Bandanzahl As Double
  Dim Bandbezugslinie1 As Double
  Dim Bandbezugslinie2 As Double
  Dim Bandbezugslinie3 As Double
  Dim Mittelanschlagsdurchmesser As Double
  Dim Türtyp As Double
  Dim Planettyp As Double
  Dim Türe_fasen As Double
  Dim Dichtungsnut As Double
  Dim Ausschnitttyp As Double
  Dim Rosettenbohrung As Double
  Dim Dornmass As Double
  Dim Abstand_Oberflächenfalle As Double
  
  Dim BereichsGrenzeStart As String
  Dim BereichsGrenzeEnde As String
  BereichsGrenzeStart = "[001"
  BereichsGrenzeEnde = "]1"
  
  Dim LaengePos As String
  Dim BreitePos As String
  Dim DickePos As String
  Dim BandseitePos As String
  Dim SchwellePos As String
  Dim RahmenfasenPos As String
  Dim RokustripPos As String
  Dim KappenPos As String
  Dim Rahmenbreite_BandseitePos As String
  Dim Rahmenbreite_SchliessblechseitePos As String
  Dim Rahmenbreite_obenPos As String
  Dim SchliessblechpositionPos As String
  Dim FalztiefePos As String
  Dim FalzhöhePos As String
  Dim SchliesblechtypPos As String
  Dim DrückerhöhePos As String
  Dim TürluftobenPos As String
  Dim BodenluftPos As String
  Dim TürblatlängePos As String
  Dim BandtypPos As String
  Dim BandanzahlPos As String
  Dim BandbezugslinieaPos As String
  Dim BandbezugsliniebPos As String
  Dim BandbezugsliniecPos As String
  Dim MittelanschlagsdurchmesserPos As String
  Dim TürtypPos As String
  Dim PlanettypPos As String
  Dim Türe_fasenPos As String
  Dim DichtungsnutPos As String
  Dim AusschnitttypPos As String
  Dim RosettenbohrungPos As String
  Dim DornmassPos As String
  Dim Abstand_OberflächenfallePos As String

  
  
LaengePos = "l="
BreitePos = "b="
DickePos = "d="
BandseitePos = "bs="
SchwellePos = "schwelle"
RahmenfasenPos = "rahfas"
RokustripPos = "roku"
KappenPos = "kappen"
Rahmenbreite_BandseitePos = "bb"
Rahmenbreite_SchliessblechseitePos = "bsc"
Rahmenbreite_obenPos = "rbqo"
SchliessblechpositionPos = "fath"
FalztiefePos = "fat"
FalzhöhePos = "fah"
SchliesblechtypPos = "sctyp"
DrückerhöhePos = "scdh"
TürluftobenPos = "luft"
BodenluftPos = "boluft"
TürblatlängePos = "tbllaeng"
BandtypPos = "batyp"
BandanzahlPos = "baz"
BandbezugslinieaPos = "bh1"
BandbezugsliniebPos = "bh2"
BandbezugsliniecPos = "bh3"
MittelanschlagsdurchmesserPos = "anschldm"
TürtypPos = "tuertyp"
PlanettypPos = "pttyp"
Türe_fasenPos = "tuerfas"
DichtungsnutPos = "dinut"
AusschnitttypPos = "auschtyp"
RosettenbohrungPos = "rosbohr"
DornmassPos = "scdm"
Abstand_OberflächenfallePos = "scfa"

  
  Dim DirInput As String
  DirInput = Sheets("CNC Programm").Range("U4").Value
  Dim DirOutput As String
  DirOutput = Sheets("CNC Programm").Range("U6").Value
  pos = Sheets("CNC Programm").Range("V9").Value
  Dim FSO
  Set FSO = CreateObject("Scripting.Filesystemobject")
  If Not FSO.FolderExists(DirOutput) Then
    CreateFullPath DirOutput
  End If
  
  
  For Zeile = 16 To 50

    If Not Sheets("CNC Programm").Range("V" & Zeile) = "" And Not Sheets("CNC Programm").Range("V" & Zeile) = "" Then
    
      With Sheets("CNC Programm")
DateiNameInput = DirInput & "\" & .Range("V" & Zeile).Value
DateiNameOutput = DirOutput & "\" & "Pos" & "_" & pos & "_" & .Range("U" & Zeile).Value & ".mpr"
Laenge = .Range("W" & Zeile).Value
Breite = .Range("X" & Zeile).Value
Dicke = .Range("Y" & Zeile).Value
Bandseite = .Range("AC" & Zeile).Value
Schwelle = .Range("Z" & Zeile).Value
Rahmenfasen = .Range("AA" & Zeile).Value
Rokustrip = .Range("AB" & Zeile).Value
Kappen = .Range("AD" & Zeile).Value
Rahmenbreite_Bandseite = .Range("AE" & Zeile).Value
Rahmenbreite_Schliessblechseite = .Range("AF" & Zeile).Value
Rahmenbreite_oben = .Range("AG" & Zeile).Value
Schliessblechposition = .Range("AH" & Zeile).Value
Falztiefe = .Range("AI" & Zeile).Value
Falzhöhe = .Range("AJ" & Zeile).Value
Schliesblechtyp = .Range("AK" & Zeile).Value
Drückerhöhe = .Range("AL" & Zeile).Value
Türluftoben = .Range("AM" & Zeile).Value
Bodenluft = .Range("AN" & Zeile).Value
Türblatlänge = .Range("AO" & Zeile).Value
Bandtyp = .Range("AP" & Zeile).Value
Bandanzahl = .Range("AQ" & Zeile).Value
Bandbezugsliniea = .Range("AR" & Zeile).Value
Bandbezugslinieb = .Range("AS" & Zeile).Value
Bandbezugsliniec = .Range("AT" & Zeile).Value
Mittelanschlagsdurchmesser = .Range("AU" & Zeile).Value
Türtyp = .Range("AV" & Zeile).Value
Planettyp = .Range("AW" & Zeile).Value
Türe_fasen = .Range("AX" & Zeile).Value
Dichtungsnut = .Range("AY" & Zeile).Value
Ausschnitttyp = .Range("AZ" & Zeile).Value
Rosettenbohrung = .Range("BA" & Zeile).Value
Dornmass = .Range("BB" & Zeile).Value
Abstand_Oberflächenfalle = .Range("BC" & Zeile).Value
         
        End With
      
      Dim readFile As Integer
      Dim writeFile As Integer
      Dim AktTxt As String

      readFile = FreeFile
      Open DateiNameInput For Input As #readFile

      writeFile = FreeFile
      Open DateiNameOutput For Output As #writeFile

      Do Until EOF(readFile)
        Line Input #readFile, AktTxt
        If InStr(AktTxt, BereichsGrenzeStart) <> 0 Then
          'Schreibe [001 in writeFile
          Print #writeFile, AktTxt
          Do Until AktTxt = ""
            Line Input #readFile, AktTxt
            If InStr(AktTxt, LaengePos) <> 0 Then
              Print #writeFile, LaengePos & Chr(34) & Replace(Laenge, ",", ".") & Chr(34)
            ElseIf InStr(AktTxt, BreitePos) <> 0 Then
              Print #writeFile, BreitePos & Chr(34) & Replace(Breite, ",", ".") & Chr(34)
            ElseIf InStr(AktTxt, DickePos) <> 0 Then
              Print #writeFile, DickePos & Chr(34) & Replace(Dicke, ",", ".") & Chr(34)
            ElseIf InStr(AktTxt, BandseitePos) <> 0 Then
              Print #writeFile, BandseitePos & Chr(34) & Replace(Bandseite, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, SchwellePos) <> 0 Then
              Print #writeFile, SchwellePos & Chr(34) & Replace(Schwelle, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, RahmenfasenPos) <> 0 Then
              Print #writeFile, RahmenfasenPos & Chr(34) & Replace(Rahmenfasen, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, RokustripPos) <> 0 Then
              Print #writeFile, RokustripPos & Chr(34) & Replace(Rokustrip, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, KappenPos) <> 0 Then
              Print #writeFile, KappenPos & Chr(34) & Replace(Kappen, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, Rahmenbreite_BandseitePos) <> 0 Then
              Print #writeFile, Rahmenbreite_BandseitePos & Chr(34) & Replace(Rahmenbreite_Bandseite, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, Rahmenbreite_SchliessblechseitePos) <> 0 Then
              Print #writeFile, Rahmenbreite_SchliessblechseitePos & Chr(34) & Replace(Rahmenbreite_Schliessblechseite, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, Rahmenbreite_obenPos) <> 0 Then
              Print #writeFile, Rahmenbreite_obenPos & Chr(34) & Replace(Rahmenbreite_oben, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, SchliessblechpositionPos) <> 0 Then
              Print #writeFile, SchliessblechpositionPos & Chr(34) & Replace(Schliessblechposition, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, FalztiefePos) <> 0 Then
              Print #writeFile, FalztiefePos & Chr(34) & Replace(Falztiefe, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, FalzhöhePos) <> 0 Then
              Print #writeFile, FalzhöhePos & Chr(34) & Replace(Falzhöhe, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, SchliesblechtypPos) <> 0 Then
              Print #writeFile, SchliesblechtypPos & Chr(34) & Replace(Schliesblechtyp, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, DrückerhöhePos) <> 0 Then
              Print #writeFile, DrückerhöhePos & Chr(34) & Replace(Drückerhöhe, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, TürluftobenPos) <> 0 Then
              Print #writeFile, TürluftobenPos & Chr(34) & Replace(Türluftoben, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, BodenluftPos) <> 0 Then
              Print #writeFile, BodenluftPos & Chr(34) & Replace(Bodenluft, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, TürblatlängePos) <> 0 Then
              Print #writeFile, TürblatlängePos & Chr(34) & Replace(Türblatlänge, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, BandtypPos) <> 0 Then
              Print #writeFile, BandtypPos & Chr(34) & Replace(Bandtyp, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, BandanzahlPos) <> 0 Then
              Print #writeFile, BandanzahlPos & Chr(34) & Replace(Bandanzahl, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, BandbezugslinieaPos) <> 0 Then
              Print #writeFile, BandbezugslinieaPos & Chr(34) & Replace(Bandbezugsliniea, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, BandbezugsliniebPos) <> 0 Then
              Print #writeFile, BandbezugsliniebPos & Chr(34) & Replace(Bandbezugslinieb, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, BandbezugsliniecPos) <> 0 Then
              Print #writeFile, BandbezugsliniecPos & Chr(34) & Replace(Bandbezugsliniec, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, MittelanschlagsdurchmesserPos) <> 0 Then
              Print #writeFile, MittelanschlagsdurchmesserPos & Chr(34) & Replace(Mittelanschlagsdurchmesser, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, TürtypPos) <> 0 Then
              Print #writeFile, TürtypPos & Chr(34) & Replace(Türtyp, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, PlanettypPos) <> 0 Then
              Print #writeFile, PlanettypPos & Chr(34) & Replace(Planettyp, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, Türe_fasenPos) <> 0 Then
              Print #writeFile, Türe_fasenPos & Chr(34) & Replace(Türe_fasen, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, DichtungsnutPos) <> 0 Then
              Print #writeFile, DichtungsnutPos & Chr(34) & Replace(Dichtungsnut, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, AusschnitttypPos) <> 0 Then
              Print #writeFile, AusschnitttypPos & Chr(34) & Replace(Ausschnitttyp, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, RosettenbohrungPos) <> 0 Then
              Print #writeFile, RosettenbohrungPos & Chr(34) & Replace(Rosettenbohrung, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, DornmassPos) <> 0 Then
              Print #writeFile, DornmassPos & Chr(34) & Replace(Dornmass, ",", ".") & Chr(34)
              ElseIf InStr(AktTxt, Abstand_OberflächenfallePos) <> 0 Then
              Print #writeFile, Abstand_OberflächenfallePos & Chr(34) & Replace(Abstand_Oberflächenfalle, ",", ".") & Chr(34)
              
              
              
            Else
              Print #writeFile, AktTxt
            End If
          Loop
        Else
          Print #writeFile, AktTxt
        End If
      Loop

      Close #readFile
      Close #writeFile
    End If
  Next
  MsgBox "Ich habe fertig...", vbInformation
  
  Exit Sub
  
Fehler:
  MsgBox Err.Number & ": " & Err.Description, vbCritical
  
End Sub

Public Sub CreateFullPath(ByVal Path As String)
     Dim FSO As Object
     Dim ParentPath As String
     
     Set FSO = CreateObject("Scripting.FileSystemObject")
     
     ParentPath = FSO.GetParentFolderName(Path)
     If Not FSO.FolderExists(ParentPath) Then CreateFullPath ParentPath
     If Not FSO.FolderExists(Path) Then FSO.CreateFolder Path
End Sub