Zeichenkette in Textdatei suchen & ersetzen

Sub SubstituteSave()
Dim arr() As String
Dim iCounter As Integer
Dim sSource As String, sTarget As String, sTxtA As String
Dim sTxtB As String, sTxt As String, sPath As String
sPath = ThisWorkbook.Path & "\"
sSource = sPath & Range("b1").Value     ' Name der Textdatei
sTarget = sPath & Range("b4").Value     ' Neuer Name der Textdatei
sTxtA = Range("b2").Value               ' alter Text
sTxtB = Range("b3").Value               ' neuer Text
Close
Open sSource For Input As #1
Do Until EOF(1)
Line Input #1, sTxt
If InStr(sTxt, sTxtA) Then
sTxt = Replace(sTxt, sTxtA, sTxtB)
End If
iCounter = iCounter + 1
ReDim Preserve arr(1 To iCounter)
arr(iCounter) = sTxt
Loop
Close
Open sTarget For Output As #1
For iCounter = 1 To UBound(arr)
Print #1, arr(iCounter)
Next iCounter
Close
On Error GoTo ERRORHANDLER
Shell "notepad " & sTarget, vbMaximizedFocus
Exit Sub
ERRORHANDLER:
MsgBox " Job erledigt!"
End Sub