Tipp 0421 Daten speichern/lesen (Text-Datei)
Autor/Einsender:
Datum:
  Angie
24.10.2004
Entwicklungsumgebung:   Excel 2000
Mit der in Excel integrierten OpenText-Methode können Text-Dateien in Excel geöffnet werden, dabei wird die Text-Datei als neue Arbeitsmappe mit einem einzelnen Blatt geladen (siehe dazu unseren Tipp Textdatei öffnen. Mit der SaveAs-Methode können Arbeitsmappen im gewünschten Format gespeichert werden. Diese beiden Methoden funktionieren recht gut.
Je nach Anforderung kann es jedoch notwendig sein, dass man das Speichern und Lesen der Daten selber programmieren muss, sei es, weil man nur bestimmte Daten speichern/einlesen möchte oder aber die Daten in bereits bestehende Tabellenblätter einlesen und/oder anfügen möchte, usw.
Die folgenden Beispiele können als Grundlage für das Speichern und Lesen von Daten aus einer Text-Datei verwendet werden und beliebig angepasst werden.
Tabellenblatt-Daten aus Text-Datei lesen
 
Public Function ReadDataTextFile(ByVal sFileName As String, _
      ByVal sDelimiter As String, ByVal wksDest As Worksheet, _
      Optional ByVal fClearContents As Boolean = True) As Boolean

  Dim FN            As Integer
  Dim strLineText   As String

  Dim avarData      As Variant
  Dim avarItems     As Variant
  Dim avarWksData   As Variant

  Dim nRowsCnt      As Long
  Dim nColsCnt      As Long
  Dim nItemsCnt     As Long

  Dim nColsMax      As Long

  Dim nRow          As Long
  Dim nCol          As Long

  Dim varValue      As Variant

  nRowsCnt = -1
  ReDim avarData(0 To 0)

  FN = FreeFile()
  Open sFileName For Input As #FN
    While Not EOF(FN)
      Line Input #FN, strLineText
      nRowsCnt = nRowsCnt + 1
      If (nRowsCnt Mod 100) = 0 Then
        ReDim Preserve avarData(0 To nRowsCnt + 100)
      End If
      avarData(nRowsCnt) = strLineText
    Wend
  Close #FN

  If nRowsCnt > -1 Then
    ReDim Preserve avarData(0 To nRowsCnt)
  Else
    MsgBox "Keine Daten in Text-Datei enthalten!", _
            vbOKOnly + vbInformation, "VB-fun-Demo"
    Exit Function
  End If

  On Error GoTo err_ReadData

  nColsMax = wksDest.Columns.Count - 1
  nColsCnt = 0

  ReDim avarWksData(0 To nRowsCnt, 0 To nColsCnt)

  For nRow = 0 To UBound(avarData)
    avarItems = Split(avarData(nRow), sDelimiter)
    If UBound(avarItems) > -1 Then
      nItemsCnt = UBound(avarItems)
      If nItemsCnt > nColsCnt Then
        nColsCnt = nItemsCnt
        If nColsCnt > nColsMax Then
          nColsCnt = nColsMax
          nItemsCnt = nColsMax
        End If
        ReDim Preserve avarWksData(0 To nRowsCnt, 0 To nColsCnt)
      End If

      For nCol = 0 To nItemsCnt
        varValue = avarItems(nCol)
        avarWksData(nRow, nCol) = varValue
      Next
    End If
  Next

  If fClearContents Then
    wksDest.Cells.ClearContents
    nRow = 1
  Else
    With wksDest
      If Application.WorksheetFunction.CountA(.Cells) > 0 Then
        nRow = .Cells.Find(What:="*", After:=.Range("A1"), _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious).Row + 1
      Else
        nRow = 1
      End If
    End With
  End If

  If nRow + UBound(avarWksData, 1) > wksDest.Rows.Count Then
    Err.Raise vbObjectError + 513

  Else
    With wksDest
      wksDest.Cells(nRow, 1).Resize(UBound(avarWksData, 1) + 1, _
            UBound(avarWksData, 2) + 1) = avarWksData
    End With

    ReadDataTextFile = True
  End If

exit_Func:
  On Error GoTo 0
  Exit Function

err_ReadData:
  Dim strErrMsg As String

  Select Case Err.Number
    Case vbObjectError + 513
      strErrMsg = "Zu viele Zeilen. " & vbCr & _
            "Daten können nicht importiert werden!"

    Case Else
      strErrMsg = "Fehler-Nr. " & Err.Number & vbCr & _
            Err.Description
  End Select

  MsgBox strErrMsg, vbOKOnly + vbCritical, _
        "VB-fun-Demo - Daten aus Textdatei importieren"
    Resume exit_Func
End Function
 
Beispiel-Aufruf - Tabellenblatt-Daten aus Text-Datei lesen
 
Sub ReadDataTextFile_Start()
  Dim varRetVal     As Variant
  Dim strFileName   As String

  ChDrive ThisWorkbook.Path
  ChDir ThisWorkbook.Path

  varRetVal = Application.GetOpenFilename( _
        FileFilter:="Text-Dateien (*.txt), *.txt", _
        Title:="Daten aus Text-Datei importieren")

  If varRetVal = False Then Exit Sub

  strFileName = varRetVal

  Dim wksDest As Worksheet
  Set wksDest = ActiveWorkbook.Worksheets.Add

  If ReadDataTextFile(strFileName, ";", wksDest, False) Then
      MsgBox "Das Importieren der Daten war erfolgreich!", _
            vbOKOnly + vbInformation, _
            "VB-fun-Demo - Daten aus Textdatei importieren"
  End If

  Set wksDest = Nothing
End Sub
 
Tabellenblatt-Daten in Text-Datei speichern
 
Public Function SaveDataTextFile(ByVal rngSrc As Range, _
     ByVal sFileName As String, ByVal sDelimiter As String) _
     As Boolean

  Dim avarWksData   As Variant

  Dim nRowsCnt      As Long
  Dim nColsCnt      As Long

  Dim nRow          As Long
  Dim nCol          As Long

  Dim FN            As Integer
  Dim strFileText   As String

  On Error GoTo err_SaveData

  avarWksData = rngSrc.Value

  nRowsCnt = UBound(avarWksData, 1)
  nColsCnt = UBound(avarWksData, 2)

  FN = FreeFile()
  Open sFileName For Output As #FN
    For nRow = 1 To nRowsCnt
      For nCol = 1 To nColsCnt - 1
        strFileText = strFileText & avarWksData(nRow, nCol) & _
                         sDelimiter
      Next
      strFileText = strFileText & avarWksData(nRow, nColsCnt)

      Print #FN, strFileText
      strFileText = ""
    Next
  Close #FN

  SaveDataTextFile = True

exit_Func:
  On Error GoTo 0
  Exit Function

err_SaveData:
  MsgBox "Fehler-Nr. " & Err.Number & vbCr & Err.Description, _
        vbOKOnly + vbCritical, _
        "VB-fun-Demo - Daten in Textdatei exportieren"
  Resume exit_Func
End Function
 
Beispiel-Aufruf - Tabellenblatt-Daten in Text-Datei speichern
 
Sub SaveDataTextFile_Start()
  Dim varRetVal     As Variant
  Dim strInitName   As String
  Dim strFileName   As String

  Dim strDelimiter  As String

  ChDrive ThisWorkbook.Path
  ChDir ThisWorkbook.Path

  strInitName = "Test"
  varRetVal = Application.GetSaveAsFilename( _
        InitialFilename:=strInitName, _
        FileFilter:="Text-Dateien (*.txt), *.txt", _
        Title:="Daten exportieren in Text-Datei")

  If varRetVal = False Then Exit Sub

  strFileName = varRetVal
  strDelimiter = ";"

  Dim wksSrc As Worksheet
  Dim rngSrc As Range

  If UCase$(TypeName(ActiveWorkbook.ActiveSheet)) = _
        "WORKSHEET" Then
    Set wksSrc = ActiveWorkbook.ActiveSheet
  Else
    MsgBox "Bitte aktivieren Sie ein Tabellenblatt " & _
           "und versuchen Sie es erneut!", vbInformation, _
          "VB-fun-Demo - Daten in Textdatei exportieren"
    Exit Sub
  End If

  Set rngSrc = wksSrc.UsedRange
  If SaveDataTextFile(rngSrc, strFileName, strDelimiter) Then
    MsgBox "Das Exportieren der Daten war erfolgreich!", _
             vbOKOnly + vbInformation, _
             "VB-fun-Demo - Daten in Textdatei exportieren"
  End If

  Set rngSrc = Nothing
  Set wksSrc = Nothing
End Sub
 
Anmerkung
Die einfachste aber auch langsamste Methode Zellen zu bearbeiten besteht darin, auf jede Zelle einzeln zuzugreifen, d. h., sollte eine Bearbeitung der Daten notwendig sein, so sollten diese Änderungen im Datenfeld vorgenommen werden, bevor die Daten ins Tabellenblatt geschrieben werden.
Weitere Links zum Thema
Daten in Zellen schreiben
Daten speichern/lesen (Binär-Datei)
Datenfeld (Variant) in Binär-Datei speichern
Hinweis
Die Ersatzfunktion für Excel 97 für die in diesem Beispiel verwendete Split-Funktion ist im Download enthalten und kann in Excel im VB-Editor importiert werden.

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
Excel-Version
95
97
2000
2002 (XP)
2003
2007
2010


Download  (25,4 kB) Downloads bisher: [ 2133 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Sonntag, 29. Mai 2011