AW: @Micahele Schefller: textdatei öffnen
29.07.2003 15:28:27
Michael Scheffler
Hi,
so ähnlich wie hier:
Sub LiesDat()
'
Sub zum Lesen der Messwertdateien
' Michael Scheffler 2002
Dim cExcelFile As clsExcelFile ' Excel-Klasse
Dim cString As clsString
Dim varFileToOpen As Variant ' Name der Datei
Dim strZeile As String, strZeileArr() As String ' Datenstring
Dim intFree As Integer, intFile As Integer ' Nr. der offenen Datei, Excelfile
Dim lngNr As Long
Dim bytWort As Byte, lngDifBetween As Long
Dim lngDif As Long, strDif As String
' Klasseninstanzen definieren
Set cExcelFile = New clsExcelFile
Set cString = New clsString
' Eingabedatei
varFileToOpen = Application _
.GetOpenFilename("Data Files (*.dat), *.dat") ' Öffnen Dialog
If varFileToOpen <> False Then
MsgBox "Open " & varFileToOpen, vbInformation
Else ' Wenn nix, dann raus
MsgBox "It's a pity!", vbExclamation
Exit Sub
End If
' Wieviel Zeilen dazwischen abfragen
strDif = "False"
While Not IsNumeric(strDif)
strDif = InputBox("Number of lines to read ", "Lines", 1)
If strDif = "" Then Exit Sub
Wend
' Initialisierung
lngDifBetween = Val(strDif)
lngDif = 1
intFree = FreeFile ' neue Datei-Nr. bestimmen.
lngNr = 1
intFile = 1
' Fortschrittsanzeige
Load frmProgress
frmProgress.Caption = "Processing data of " & varFileToOpen & " please wait..."
frmProgress.Show
Open varFileToOpen For Input As #intFree ' Datei öffnen
varFileToOpen = Replace(varFileToOpen, ".", "_")
Set cExcelFile = CreateExcel(varFileToOpen, intFile) ' 1. Temp. Excelfile öffnen
Do While Not EOF(intFree) ' Dateiende abfragen
DoEvents
On Error Resume Next
Line Input #intFree, strZeile ' Datenzeilen lesen.
strZeileArr = cString.SplitString(strZeile, vbTab)
If UBound(strZeileArr) > 0 Then
For bytWort = LBound(strZeileArr) To UBound(strZeileArr)
If IsNumeric(strZeileArr(bytWort)) Then
With cExcelFile
If lngDif = 1 Then
.WriteValue xlsNumber, xlsFont0, xlsRightAlign, xlsNormal, lngNr, bytWort + 1, Val(strZeileArr(bytWort)), 4
End If
If bytWort = UBound(strZeileArr) Then
If lngDif = 1 Then lngNr = lngNr + 1
lngDif = lngDif + 1
End If
End With
Else
With cExcelFile
.WriteValue xlsText, xlsFont0, xlsRightAlign, xlsNormal, lngNr, bytWort + 1, strZeileArr(bytWort), 3
If bytWort = UBound(strZeileArr) Then lngNr = lngNr + 1
End With
End If
Next bytWort
Else
With cExcelFile
.WriteValue xlsText, xlsFont0, xlsRightAlign, xlsNormal, lngNr, 1, strZeile, 3
lngNr = lngNr + 1
End With
End If
If lngDif = lngDifBetween Then lngDif = 1
If lngNr Mod 1000 = 0 Then ProgressBar lngNr / 65536
If lngNr = 65536 Then
lngNr = 1
cExcelFile.CloseFile
intFile = intFile + 1
Set cExcelFile = CreateExcel(varFileToOpen, intFile)
End If
Loop
On Error Resume Next
cExcelFile.CloseFile
Close #intFree ' Datei schließen
Set cExcelFile = Nothing
Set cString = Nothing
Unload frmProgress
MsgBox "Fertsch!", vbInformation
End Sub
Gruß
Micha