Clever-Excel-Forum

Liebe VBA-Fans,

ich möchte gerne mittels VBA eine Textdatei manipulieren. Zunächst würde ich gerne mal von
euch wissen wie man z.B. die 5. Zeile ausliest und bei Bedarf ändern kann. Auch wäre es
schön zu erfahren wie ich in unter einer beliebigen Zeile in einer solchen Textdatei
eine Zeile einfügen könnte.

Vielen Dank schon mal für eure Hilfe.

Wulfi

Hallo Wulfi,

hast Du schon mal was mit VBA getan?

Hier mal ein Lösungsansatz, der Dir die 5. Zeile als Meldung ausgibt.

PHP-Code:
Sub TXT_import()
'Variablendeklaration
'Integer
Dim iffile%, iCntLine%
'String
fim strline$
  'Dateinummer zuweisen
  iffile = FreeFile
  'Datei oeffnen
  Open "D:\Test\test.txt" For Input As #iffile
  'Datei bis Dateiende zeilenweise einlesen
  Do While Not EOF(1)
      'Zeile einlesen
      Line Input #iffile, strline
      'Zeilenzaehler hochsetzen
      iCntLine = iCntLine + 1
      'Wenn Zeilennumer = 5, dann
      If iCntLine = 5 Then
          'Zeile als Meldung ausgeben
          MsgBox strline
      'Ende Wenn Zeilennumer = 5, dann
      End If
  'Ende Datei bis Dateiende zeilenweise einlesen
  Loop
  'Datei schliessen
  Close #iffile
End Sub 

Hallo Wulfi,

ich benutze mal die Vorlage Textdateien Lesen - Schreiben - Ändern von Peter Haserodt.

Also am besten in ein separates Modul die beiden Zugriffsroutinen schreiben:

Code:
' **************************************************************

'  Modul:  mdlTextOperationen  Typ = Allgemeines Modul

' **************************************************************

Option Explicit

Option Private Module

Public Function dat_ReadText(DerPfad As String) As String

  Dim sText As String, iFrei As Integer, i As Long

  On Error GoTo Fehler

  sText = ""

  iFrei = FreeFile

  Open DerPfad For Binary Access Read As #iFrei

  i = LOF(iFrei)

  sText = String(i, 0)

  Get #iFrei, , sText

  Close #iFrei

  dat_ReadText = sText

  Exit Function

Fehler:

  MsgBox Err.Description

End Function

Public Sub dat_WriteText(DerPfad As String, DerText As String)

  Dim iFrei As Integer

  On Error GoTo Fehler

  iFrei = FreeFile

  Open DerPfad For Output As #iFrei

  Print #iFrei, DerText;

  Close #iFrei

  Exit Sub

Fehler:

  MsgBox Err.Description

End Sub

Und hier dann das eigentliche Änderungsmakro:

Code:
Public Sub TextBearbeiten()

  Dim sPfad As String, sTextRaus As String, sTextRein As String

  Dim vText As Variant

  sPfad = "C:\Users\Uwe\Documents\Excel\Foren\Textdatei.txt" ' Pfad anpassen

  'Einlesen der Datei

  sTextRein = dat_ReadText(sPfad)

  'Kontrolle

  MsgBox sTextRein

  'Text wird zeilenweise in Arrayvariable eingelesen

  vText = Split(sTextRein, vbNewLine)

  'Zeile 5 bearbeiten, wenn vorhanden

  If UBound(vText) > 3 Then

    vText(4) = InputBox("Zeile 5 bearbeiten", , vText(4))

  End If

  'Abschnitt für neue Zeile

  ReDim Preserve vText(UBound(vText) + 1)

  vText(UBound(vText)) = InputBox("Neue Zeile anhängen")

  If Len(vText(UBound(vText))) = 0 Then

    If MsgBox("Soll wirklich eine neue leere Zeile angehängt werden?", vbYesNo, "Rückfrage") = vbNo Then

      ReDim Preserve vText(UBound(vText) - 1)

    End If

  End If

  'bearbeiteten Text in Datei zurückschreiben

  sTextRaus = Join(vText, vbNewLine)

  dat_WriteText sPfad, sTextRaus

  'Kontrolle

  sTextRein = dat_ReadText(sPfad)

  MsgBox sTextRein

End Sub

Hinweis:
Ist die Textdatei (noch) nicht vorhanden, wird sie (beim Einlesen) automatisch erstellt.

Gruß Uwe

Hallo Uwe,

habe gerade Deinen Code ausgetestet und bin begeistert. Das hat mir
einiges an Recherche erspart. Den Code kann ich jetzt bequem in
mein bestehendes Programm einbauen. Nochmals vielen, vielen Dank!

Dir noch einen schönen Sonntag.

Wulfi

Wulfi

schauan

Kuwer

Wulfi