Hi,

The code you got from internet is assuming that there is always enough memory provided by Excel (I mean the memory provided by Excel, not the available RAM) to hold entire file being read, and since you play with very large files and if one or more of your files are larger than the Excel's memory, an error will be raised.
You can read it here in stackoverflow site : http://www.stackoverflow.com/questio...ray-size-limit

So we must play safe, lets take 450M as a safe value, if the file size is exceeding this value, then we must read it in chunks (as my previous code did).
If you see my previous code, I set the value of FileBufferSize = 50000 (50 KB), because I don't know how big is your files.
I have modify the code to use the maximum array limit size and using array instead of string, it should be much faster now.

Sub CountLines(SourcePath)
  Const FileBufferSize = 450000000
  Dim MyFSO As Object, MyFolder As Object, MyFile As Object
  Dim arrFile, totalFile As Long, pFile As Long, arrData() As Byte, counter As Long
  Dim lastRow As Long, lastCol As Long, isExist As Boolean, strStatusBar As String
  Dim i As Long, j As Long

  Set MyFSO = CreateObject("Scripting.FileSystemObject")
  Set MyFolder = MyFSO.GetFolder(SourcePath)
  totalFile = MyFolder.Files.Count

  ReDim arrFile(1 To totalFile, 1 To 2)
  totalFile = 0
  For Each MyFile In MyFolder.Files
      If UCase(Right(MyFile, 4)) = ".TXT" Then
         totalFile = totalFile + 1
         arrFile(totalFile, 1) = MyFile.Path
         arrFile(totalFile, 2) = MyFile.Size
      End If
  Next MyFile

  pFile = FreeFile
  For i = 1 To totalFile
      counter = 0
      Open arrFile(i, 1) For Binary Access Read As pFile
        strStatusBar = "Processing " & arrFile(i, 1) & Space(3)
        Application.StatusBar = strStatusBar

        If arrFile(i, 2) < FileBufferSize Then
           ReDim arrData(LOF(pFile))
        Else
           ReDim arrData(FileBufferSize)
        End If

        While Not EOF(pFile)
          If Len(Application.StatusBar) < 250 Then
             Application.StatusBar = Application.StatusBar & "."
          Else
             Application.StatusBar = strStatusBar
          End If

          Get pFile, , arrData
          For j = LBound(arrData) To UBound(arrData)
              If arrData(j) = 13 Then
                 counter = counter + 1
              End If
          Next j
        Wend
      Close pFile
      arrFile(i, 2) = counter + 1
  Next i
  Erase arrData
  Application.StatusBar = ""

  With ActiveSheet
    .Cells(1, 1) = "Filename"
    .Cells(1, 2) = "Current Location"
    lastRow = .Cells(Cells.Rows.Count, 1).End(xlUp).Row
    lastCol = .Cells(1, Cells.Columns.Count).End(xlToLeft).Column + 1
    .Cells(1, lastCol) = Evaluate("=TEXT(NOW(),""mmmm"")")
    For i = 1 To totalFile
        isExist = False
        For j = 2 To lastRow
            If .Cells(j, 1).Value = arrFile(i, 1) Then
               .Cells(j, lastCol) = arrFile(i, 2)
               .Cells(j, 2) = SourcePath
               isExist = True
               Exit For
            End If
        Next j
        If Not isExist Then
           lastRow = lastRow + 1
           .Cells(lastRow, 1) = arrFile(i, 1)
           .Cells(j, 2) = SourcePath
           .Cells(lastRow, lastCol) = arrFile(i, 2)
        End If
    Next i
  End With
End Sub