Import pliku txt ponad 65536 linii

Poniższy kod (nie testowany przeze mnie) importuje dane z pliku tekstowego zawierającego więcej rekordów niż limit wynikający z liczby rekordów pojedynczego arkusza excela. Kolejne rekordy są importowane do kolejnych arkuszy excela.

Kod został opublikowany na grupie microsoft.public.excel.programming (dodałem tylko na końcu Application.ScreenUpdating = True).

Sub LargeFileImport()
 

'Dimension Variables
Dim ResultStr As String
Dim FileName As String
Dim FileNum As Integer
Dim Counter As Double
 

    'Ask User for File's Name
    FileName = Application.GetOpenFilename
    'Check for no entry
    If FileName = "" Then End
    'Get Next Available File Handle Number
    FileNum = FreeFile()
 

    'Open Text File For Input
    Open FileName For Input As #FileNum
    'Turn Screen Updating Off
    Application.ScreenUpdating = False
 

    'Create A New WorkBook With One Worksheet In It
    Workbooks.Add Template:=xlWorksheet
    'Set The Counter to 1
    Counter = 1
 

    'Loop Until the End Of File Is Reached
    Do While Seek(FileNum) <= LOF(FileNum)
        'Display Importing Row Number On Status Bar
        Application.StatusBar = "Importing Row " & _
        Counter & " of text file " & FileName
        'Store One Line Of Text From File To Variable
        Line Input #FileNum, ResultStr
        'Store Variable Data Into Active Cell
        If Left(ResultStr, 1) = "=" Then
            ActiveCell.Value = "'" & ResultStr
        Else
            ActiveCell.Value = ResultStr
        End If
        'For xl95 change 65536 to 16384
        If ActiveCell.Row = 65536 Then
            'If On The Last Row Then Add A New Sheet
                ActiveWorkbook.Sheets.Add
            Else
                'If Not The Last Row Then Go One Cell Down
                ActiveCell.Offset(1, 0).Select
        End If
        'Increment the Counter By 1
        Counter = Counter + 1
        'Start Again At Top Of 'Do While' Statement
    Loop
 

    'Close The Open Text File
    Close
    'Remove Message From Status Bar
    Application.StatusBar = False
    Application.ScreenUpdating = True
 

End Sub

---