"Out of memory" 停止行计数器

"Out of memory" stops the row counter

我的脚本计算每个文件的行数。但是,如果我将限制器设置得太高(如 500.000 或 1M)或者文件太多,脚本不会计算每个文件的行数,因为程序 运行 内存不足。 (限制器不是必须的,我已经把它放在"run out of memory"的问题上了,本来我不想用的。)

Sub counter()
    Dim fso As New FileSystemObject
    Dim ts As TextStream
    Dim longtext As String
    Dim lines As Variant
    Dim GoToNum As Integer
    Dim Start As Integer
    GoToNum = 2
    Start = 3

    Do Until IsEmpty(Cells(Start, 1))
        GoToNum = GoToNum + 1
        Start = Start + 1
    Loop

    For i = 3 To GoToNum

        If Cells(i, 2).Value <= Cells(2, 5).Value Then

            ConOrg = Cells(1, 4).Value & "\" & Cells(i, 1).Value

            Set ts = fso.OpenTextFile(ConOrg, ForReading, False)
            longtext = ts.ReadAll

            ts.Close
            lines = Split(longtext, vbLf)
            Cells(i, 3) = UBound(lines) - LBound(lines) - 1

        End If

    Next i

End Sub

脚本如何在没有 "run out of memory" 的情况下计算每个文件的行数?

这里是您如何避免 fso 并仍然按照您的意愿行事的示例。

   Sub LinesCounter()

    Dim Path As String
    Dim FileName As String
    Dim SomeText As String
    Dim TextLine As String
    Dim LineCounter As Long
    Dim i As Long
    Dim GoToNum, Start As Long

    Path = Cells(1, 5).Value
    Start = 3

    Do Until IsEmpty(Cells(Start, 1))
        GoToNum = GoToNum + 1
        Start = Start + 1
    Loop

    For i = 3 To GoToNum
            FileName = Cells(i, 1).Value

            Open Path & FileName For Input As #1
                Do Until EOF(1)
                    Line Input #1, TextLine
                    'SomeText = SomeText & " " & TextLine
                    LineCounter = LineCounter + 1
                Loop
            Close #1
            'you can comment line below, it's only for testing
            Debug.Print "There is a: " & LineCounter & " lines in " & _
            FileName & " text file."

            'Adding values to Excel sheet
            Cells(i, 3) = LineCounter
    Next i
    End Sub