|
Option Explicit
Private Sub cmdReplace_Click()
Dim strFind As String
Dim strReplace As String
strFind = txtFind.Text
If Len(strFind) = 0 Then
MsgBox "Bitte den zu suchenden/löschenden Text eingeben!", _
vbInformation, Me.Caption
txtFind.SetFocus
Else
strReplace = txtReplace.Text
FindAndReplace App.Path, "Beispiel.txt", strFind, strReplace, _
CBool(chkDeleteLines.Value), CBool(chkDeleteBlanks.Value)
End If
End Sub
Private Sub FindAndReplace(ByVal vsPath As String, _
ByVal vsFileName As String, ByVal vsFind As String, _
ByVal vsReplace As String, _
Optional bDeleteLines As Boolean = False, _
Optional bDeleteBlanks As Boolean = True, _
Optional bCompare As VbCompareMethod = vbTextCompare)
Dim strFileName As String
Dim strTempFile As String
Dim FN1 As Integer
Dim FN2 As Integer
Dim strLine As String
On Error GoTo err_Handler
If Right$(vsPath, 1) <> "\" Then vsPath = vsPath & "\"
strFileName = vsPath & vsFileName
strTempFile = vsPath & "Temp_" & vsFileName
FileCopy strFileName, strTempFile
FN1 = FreeFile()
Open strTempFile For Input As #FN1
FN2 = FreeFile()
Open strFileName For Output As #FN2
Do While Not EOF(FN1)
Line Input #FN1, strLine
If InStr(1, strLine, vsFind, bCompare) > 0 Then
strLine = _
Replace(strLine, vsFind, vsReplace, , , bCompare)
End If
If bDeleteBlanks Then
Do Until InStr(1, strLine, " ") = 0
strLine = Replace(strLine, " ", " ")
Loop
End If
If Len(Trim$(strLine)) = 0 And bDeleteLines Then
Else
Print #FN2, strLine
End If
Loop
Close #FN2
Close #FN1
Kill strTempFile
MsgBox "Der Vorgang wurde erfolgreich abgeschlossen ;-)", _
vbInformation, "Fertig"
Exit Sub
err_Handler:
MsgBox Err.Description, vbCritical, "Fehler"
End Sub
|
|