Gruppe
Extern
Problem
Die in Zelle B1 genannte Textdatei soll im Ordner dieses Verzeichnisses gesucht und geöffnet werden. Der Suchbegriff aus Zelle B2 ist durch den Ersatzbegriff aus Zelle B3 zu ersetzen.
StandardModule: basMain
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
sTarget = sPath & Range("B4").Value
sTxtA = Range("B2").Value
sTxtB = Range("B3").Value
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