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
|
|
|
|
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.
|
|
|
|
|
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: [ 2232 ]
|
|
|