Zeilenzahl einer txt-datei bestimmen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Jochen
schneller wird's nicht gehen.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Zeilen()
'Quelle: http://www.activevb.de/tipps/vb6tipps/tipp0611.html
Dim Path As String
Dim z As Long

Path = "F:\Office\1000000lines.txt"

z = GetLinesFromTextFile(Path)

MsgBox z & " Zeilen"
End Sub

Public Function GetLinesFromTextFile(Path As String) As Long
'zählt die LinesCount einer Textdatei, die Datei muss vorhanden sein

Dim FNr As Integer
Dim FileLength As Double
Dim BytesRead As Double
Dim ByteToRead As Long
Dim s As String
Dim LinesCount As Long

'ist die Datei leer
If FileLen(Path) = 0 Then
    Exit Function
End If

'Block zum Auslesen, 64K
ByteToRead = 256& * 256&
'eine Pipe zuweisen
FNr = FreeFile
'Datei binär öffnen
Open Path For Binary As #FNr
'Dateilänge feststellen
FileLength = LOF(FNr)

'Blockweise auslesen
Do
    If FileLength = BytesRead Then
        'alles ausgelesen
        Exit Do
    ElseIf (FileLength - BytesRead) < ByteToRead Then
        'den letzten Rest bestimmen
        ByteToRead = FileLength - BytesRead
    End If

    'Variable bereitstellen in Blockgrösse
    s = Space(ByteToRead)
    'Block einlesen
    Get #FNr, BytesRead + 1, s
    'LinesCount in Subroutine feststellen
    LinesCount = LinesCount + GetLinesFromString(s)
    'wie weit wurde bereits eingelesen
    BytesRead = BytesRead + ByteToRead
Loop
'der Zähler muss um 1 erhöht werden
LinesCount = LinesCount + 1

'war das letzte Zeichen ein Trenner ?
s = Space(1)
Get #FNr, FileLength, s
If s = Chr(10) Then
    'ja, letzte Zeile nicht gefüllt
    LinesCount = LinesCount - 1
End If
Close FNr

'Wert an Function
GetLinesFromTextFile = LinesCount
End Function

Private Function GetLinesFromString(s As String)
' Zeilenumbrüche in einem String zählen,
' es wird nur der LineFeed ausgewertet

Dim i As Long, j As Long, z As Long

i = 1
Do
    'suche nach Zeilentrenner
    j = InStr(i, s, Chr(10))
    If j = 0 Then
        'nix (mehr) da
        Exit Do
    End If
    'add
    z = z + 1
    'neue Position
    i = j + 1
Loop

'Wert an Function
GetLinesFromString = z
End Function

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Zeilenzahl einer txt-datei bestimmen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread