Importing big text/csv file into excel using vba - vba

Question

I get the data in csv file and I need to import the data into excel. I use the below vba code to complete my task (which I also got from some site after modified accordingly):
Sub ImportTextFile()
Dim vFileName
On Error GoTo ErrorHandle
vFileName = Application.GetOpenFilename("CSV Files (*.csv),*.csv")
If vFileName = False Or Right(vFileName, 3) <> "csv" Then
GoTo BeforeExit
End If
Application.ScreenUpdating = False
Workbooks.OpenText Filename:=vFileName, _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=False, Space:=False, _
Other:=False, TrailingMinusNumbers:=True, _
Local:=True
Columns("A:A").EntireColumn.AutoFit
BeforeExit:
Application.ScreenUpdating = True
Exit Sub
ErrorHandle:
MsgBox Err.Description
Resume BeforeExit
End Sub
Till now, this code was helping me as the number of rows/records in csv/text file were less than 1,048,576 (which is row limit of excel in a sheet). Now number of records in the csv/text file are 10 times more than the limit.
I need help to
Modify this code, which automatically produces sheets (in the same workbook) and put 1000000 records on each sheet until text/csv file ends.
I appreciate your help on this. thanks

Answer 1

You can try the below code. You need to change the value of numOfLines variable to 1046000 or whatever you need.
Make sure that the Scripting library is switched on in your Excel: Tools > References: Microsoft Scripting Control 1.0 & Microsoft Scriplet Runtime
I tested this code on a .csv file with 80 lines, but I set numOfLines to 10, so I ended up with 8 worksheets each containing just 10 rows from the .csv file.
If you change the numOfLines to 1000000, by extension, it should give you appropriate number of worksheets each containing the specified limit of rows.
Hope this helps.
Sub textStreamToExcel()
'Add Scripting references in Tools before you write this code:
'Microsoft Scripting Control 1.0 and Microsoft Scripting Runtime
Dim numOfLines As Long
numOfLines = 10 '################### change this number to suit your needs
'Enter the source file name
Dim vFileName
vFileName = Application.GetOpenFilename("Text Files (*.txt),*.txt")
If vFileName = False Then
Exit Sub
End If
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim ts As TextStream
Dim line As String
Dim counter As Long
Set ts = fso.OpenTextFile(vFileName, ForReading)
Dim wkb As Workbook
Set wkb = Workbooks.Add
wkb.Activate
'Save your file, enter your file name if you wish
Dim vSavedFile
vSavedFile = wkb.Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xls), *.xls")
If vSavedFile = False Then
Exit Sub
End If
wkb.SaveAs vSavedFile
Dim cwks As Integer
cwks = wkb.Sheets.Count
Dim iwks As Integer
iwks = 1
Dim wkbS As Excel.Worksheet
Application.ScreenUpdating = False
Looping:
counter = 1
If iwks <= cwks Then
Set wkbS = wkb.Worksheets(iwks)
wkbS.Activate
Range("A1").Activate
While counter <= numOfLines
If ts.AtEndOfStream <> True Then
line = ts.ReadLine
If ActiveCell.Value = "" Then
ActiveCell.Value = CStr(line)
End If
ActiveCell.Offset(1, 0).Activate
counter = counter + 1
Else
ts.Close
GoTo Ending
End If
Wend
Else
Set wkbS = wkb.Worksheets.Add(After:=Sheets(Sheets.Count))
wkbS.Activate
Range("A1").Activate
While counter <= numOfLines
If ts.AtEndOfStream <> True Then
'If the last line has been read it will give you an Input error
line = ts.ReadLine
If ActiveCell.Value = "" Then
ActiveCell.Value = CStr(line)
End If
ActiveCell.Offset(1, 0).Activate
counter = counter + 1
Else
ts.Close
GoTo Ending
End If
Wend
End If
iwks = iwks + 1
If ts.AtEndOfStream <> True Then
GoTo Looping
Else
GoTo Ending
End If
Ending:
Application.ScreenUpdating = True
Set fso = Nothing
Set ts = Nothing
Set wkb = Nothing
Set wkbS = Nothing
MsgBox "Transfer has been completed"
Exit Sub
ErrorHandler:
MsgBox "The following error has occured:" & Chr(13) & Chr(13) & "Error No: " & Err.Number * Chr(13) & "Description: " & Chr(13) & Err.Description
End Sub

Answer 2

In order to to import this file into Excel, you would need to break it up and place the data on multiple sheets. This is not possible the straight import method you been using. The best you can do would be to read the CSV file with ADO into a Recordset object and then output the Recordset on to the individual sheets while specifying the number of records to be output.
Overall, this will be a fairly slow process. Why are you trying to display this in Excel? Something like Access maybe a better place to store the data (or even keep it in a CSV) and then connect to it from Excel for pivot tables and/or other analysis.