Thema
In jeder Zeile einer Textdatei 1. und letztes Zeichen entfernen
Gruppe
Text
Problem
Bei der in Zelle B1 genannten Datei sollen in jeder Datenzeile das 1. und letzte Zeichen entfernt werden.
StandardModule: Modul1
Sub EditText()
Dim arr() As String
Dim lRow As Long
Dim sPath As String, sTxt As String
sPath = Range("B1").Value
If Dir(sPath) = "" Then
Beep
MsgBox "Datei " & sPath & " wurde nicht gefunden!"
Exit Sub
End If
Close
Open sPath For Input As #1
Do Until EOF(1)
Line Input #1, sTxt
sTxt = Right(sTxt, Len(sTxt) - 1)
sTxt = Left(sTxt, Len(sTxt) - 1)
lRow = lRow + 1
ReDim Preserve arr(1 To lRow)
arr(lRow) = sTxt
Loop
Close
Open sPath For Output As #1
For lRow = 1 To UBound(arr)
Print #1, arr(lRow)
Next lRow
Close
End Sub