Public Sub ReplaceMessung(OrdnerPfad As String)
Dim objRegEx As Object
Dim objRegEx1 As Object
Dim objRegEx2 As Object
Dim objRegEx3 As Object
Dim objRegEx4 As Object
Dim objRegEx5 As Object
Dim fso As Object
Dim Fs As Object
Dim ts As Object
Dim strText As String
Dim strText1 As String
Dim strText2 As String
Dim strText3 As String
Dim strText4 As String
Dim strText5 As String
Dim strErsetzt As String
Dim strErsetzt1 As String
Dim strZeile As Variant
Dim strZeile1 As Variant
Dim strZeile2 As Variant
Dim strZeile3 As Variant
Dim strZeile4 As Variant
Dim strZeile5 As Variant
Set fso = CreateObject("Scripting.FileSystemObject")
strText = "TCH PROBE 586 WZ-BRUCHKONTROLLE ~"
strText1 = "Q356=+1 ;MESSRICHTUNG ~"
strText2 = "Q357=+0 ;RADIALER OFFSET ~"
strText3 = "Q359=+0 ;ADD.LAENGENKORREKTUR ~"
strText4 = "Q375=+0 ;ANFAHRSTRATEGIE ~"
strText5 = "Q376=+55 ;SICHERHEITSABSTAND"
strErsetzt = "CALL PGM TNC:\A\Bruch.h"
strErsetzt1 = ";----------------------------------"
intFilenumber = FreeFile
If Right$(OrdnerPfad, 1) <> "\" Then OrdnerPfad = OrdnerPfad & "\"
strDatei = Dir(OrdnerPfad, vbNormal Or vbReadOnly Or vbHidden Or vbSystem)
If strDatei <> vbNullString Then
Do
Set Fs = fso.GetFile(OrdnerPfad & strDatei)
Set ts = Fs.OpenAsTextStream(1, 0)
strZeile = ts.ReadAll
ts.Close
Set objRegEx = CreateObject("VBScript.RegExp")
With objRegEx
.MultiLine = True
.Global = True
.IgnoreCase = False
.Pattern = strText
strZeile1 = .Replace(strZeile, strErsetzt)
End With
With objRegEx
.MultiLine = True
.Global = True
.IgnoreCase = False
.Pattern = strText1
strZeile2 = .Replace(strZeile1, strErsetzt1)
End With
With objRegEx
.MultiLine = True
.Global = True
.IgnoreCase = False
.Pattern = strText2
strZeile3 = .Replace(strZeile2, strErsetzt1)
End With
With objRegEx
.MultiLine = True
.Global = True
.IgnoreCase = False
.Pattern = strText3
strZeile4 = .Replace(strZeile3, strErsetzt1)
End With
With objRegEx
.MultiLine = True
.Global = True
.IgnoreCase = False
.Pattern = strText4
strZeile5 = .Replace(strZeile4, strErsetzt1)
End With
With objRegEx
.MultiLine = True
.Global = True
.IgnoreCase = False
.Pattern = strText5
strZeile = .Replace(strZeile5, strErsetzt1)
End With
Open Replace(OrdnerPfad & strDatei, "Alt", "Neu") For Output As #intFilenumber
Print #intFilenumber, strZeile
Close #intFilenumber
strDatei = Dir
Loop Until strDatei = vbNullString
End If
MsgBox "Vermessung Ersetzt"
End Sub