Importing a larger file help

[TYEZ]

Hello, I want to use this file but with slight modifications. Can someone out there help me?
What I want to do is import a TXT file that has about 70000 rows of numbers into excel. I know it has a max of 65536 so I would like it to import the numbers and put them into 2 columns C and the rest in D.
Is this possible?
Thanks so much!

This is the code I want to use:

Sub ImportLargeFile() 
'Imports text file into Excel workbook using ADO. 
'If the number of records exceeds 65536 then it splits it over more than one sheet. 

    Dim strFilePath As String, strFilename As String, strFullPath As String 
    Dim lngCounter As Long 
    Dim oConn As Object, oRS As Object, oFSObj As Object 

    'Get a text file name 
    strFullPath = Application.GetOpenFilename("Text Files (*.txt),*.txt", , "Please selec text file...") 

    If strFullPath = "False" Then Exit Sub  'User pressed Cancel on the open file dialog 

    'This gives us a full path name e.g. C:tempfolderfile.txt 
    'We need to split this into path and file name 
    Set oFSObj = CreateObject("SCRIPTING.FILESYSTEMOBJECT") 

    strFilePath = oFSObj.GetFile(strFullPath).ParentFolder.Path 
    strFilename = oFSObj.GetFile(strFullPath).Name 


    'Open an ADO connection to the folder specified 
    Set oConn = CreateObject("ADODB.CONNECTION") 
    oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 
               "Data Source=" & strFilePath & ";" & _ 
               "Extended Properties=""text;HDR=Yes;FMT=Delimited""" 

    Set oRS = CreateObject("ADODB.RECORDSET") 

    'Now actually open the text file and import into Excel 
    oRS.Open "SELECT * FROM " & strFilename, oConn, 3, 1, 1 
    While Not oRS.EOF 
        Sheets.Add 
        ActiveSheet.Range("A1").CopyFromRecordset oRS, 65536 
    Wend 

    oRS.Close 
    oConn.Close 

End Sub

Right now this is the code we are using, but the problem with this one is that you have to type int he files desintation and it splits it amoung 2 worksheets.

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 = InputBox("Please enter filename followed by.txt")
      '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 Excel versions before Excel 97, 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

   

End Sub

Please help
Thanks

• Edited by Nate: Added code tags.

 

[NateO]

Hello,

Does your first procedure actually open a Recordset? I.e., have you tested this aspect of it? If so, what does the Recordset look like, and why do you have a While/Wend loop in there?

How about something like the following?

http://www.utteraccess.com/forums/showthreaded.php?Number=1146152

This crops arrays, from an ADO Recordset, based on the 'Max Rows' figure you pass as a constant. Also, I added code tags to your code, to make it readable.

 

[TYEZ]

No neither still works right. Esentually I would like the code from the first one that opens the file directly to replace the second code that asks you for the file location. The first code is one I found on this site but it spreads my file over 5 sheets not 1 or even 2 like the second code. The second code is one we have been using here but I don't like typing the file location each time. I really hope this makes sense and someone can help.

 

[NateO]

Hello,

I'm not saying copying and pasting it work in its entirety, now seeing as you grabbed it from a non-related thread, dated 4 years ago... I'm assuming some minor modification will be required... I'm sure it works as intended, but it wasn't written for your task.

Want to write VBA? Break your problem down into smaller pieces. Don't go for the big Kahuna right out of the gate! Want help with the GetOpenFilename Method?

See the following:

http://support.microsoft.com/kb/161930

However, in most of my Apps, I simply dump the filename into a cell and pull the string from there.

Personally, I'd go with the Recordset and parse that puppy, vs. looping through 65536+ cells, but it doesn't sound like you're comfortable adapting that macro...

But, again, this comes down to breaking down your problem and the related procedure into smaller pieces. I.e., don't worry about 5 worksheets, yet, you're getting way ahead of yourself. Can you open a Recordset? If so, what does the Recordset look like? Etc...

 

[TYEZ]

Well thanks for your help. I see where your going with this one. Unfortunately I am not skilled totally in Excel and code so I will just live with what I have already.

 

[NateO]

Why?

If you can experiment and get GetFileOpenFilename to dump it into a cell, you can easilly read that cell's value in the procedure, e.g.,

Msgbox Range("A1").Value

Yes-no? Just break it all down into little pieces, it's not as hard as you might think...

But, yeah, might want to skip the whole ADO Recordset bit, then...

 

[LilStevie]

http://www.cpearson.com/excel/ImportBigFiles.htm

Try out this tutorial / code to help with your import

 

[Johnny C]

If it's a straight text file, don't open it as a normal file. Open as a sequential access file, read the lines in 1 by 1 (it doesn't take long depending on your network), When you go past 64K lines, move to another sheet or another column.

Format is

OPEN pathname FOR INPUT AS file number
where file number is 1,,2,3...16
The channel number means you can read from multiple files at once if you so desire.

To read a line in, use a piece of code like the following: The '.'s are just to show indentation, don't copy them

DIM ColumnCount%, RowCount%,MaxRows%
DIM DataVariable$

ColumnCount =1
RowCount=1
MaxRows = 65000 'make it smaller if you want
DO UNTIL EOF(file number)
.....LINE INPUT #filenumber, DataVariable 'you need the #before the number
.....RowCount = RowCount + 1
.....if RowCount > MaxRows then
..........RowCount = 1
..........ColumnCount = ColumnCount + 1
.....end if
.....cells(RowCOunt, ColumnCount) = DataVariable
LOOP

Have a look in help, you can also input fields if you define fixed-length strings

Editted to add, I used to read in 2,000,000 line files and it only took 1 minute per file. I copied them to my C drive first though

 

[NateO]

Why are all of these procedures, including Chip's (as I read it), writing to Excel cell by cell? Isn't that kind of slow?

Johnny, did it take a minute to read through the file, or write the values to Excel, as well?

Slightly adjusting the combination of Dan's and my code, provided earlier in this thread, the following wrote 200,000 values to Excel, in columns A-D in 10 seconds:

Option Explicit

Sub foobar()
Dim Conn As Object, rs As Object
Dim i As Long, j As Long, tmpQuo As Currency, startPos As Long, recCount As Long
Dim fldArr() As String, varArr() As Variant, tmpArr() As Variant
Dim tmpBool As Boolean

Const maxRows As Long = 65535

Set Conn = CreateObject("ADODB.CONNECTION")

Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
           "Data Source=C:\temp\;" & _
           "Extended Properties=""text;HDR=Yes;FMT=Delimited"""


Set rs = CreateObject("ADODB.Recordset")

rs.Open "Select * From Huge_Text_File.txt", Conn, 1, 1

With rs
    If .EOF Then
        .Close:     Set rs = Nothing
        Conn.Close: Set Conn = Nothing
        Exit Sub
    End If
    ReDim fldArr(0 To .Fields.Count - 1)
    For i = LBound(fldArr) To UBound(fldArr)
        Let fldArr(i) = .Fields(i).Name
    Next
    
    Let recCount = .RecordCount
    
    If recCount <= maxRows Then
        With Worksheets(1)
            Application.ScreenUpdating = False
            Let .Range("a1").Resize(, UBound(fldArr) + 1).Value = fldArr
            .Range("a2").CopyFromRecordset rs
            Application.ScreenUpdating = True
        End With
    Else:   Let tmpBool = True
            Let varArr = rs.GetRows
    End If
    
    .Close:     Set rs = Nothing
    Conn.Close: Set Conn = Nothing
End With

If tmpBool Then
    Let tmpQuo = recCount / maxRows
    
    If Int(tmpQuo) = tmpQuo Then
        Let j = tmpQuo
    Else: Let j = Int(tmpQuo) + 1
    End If
    
    Application.ScreenUpdating = False
    With Worksheets(1)
        For i = 1 To j
            Let startPos = (i - 1) * maxRows + 1
            Let tmpArr = TransposeDim(varArr, startPos, maxRows - 1)
            Let .Cells(1, i).Resize(, UBound(fldArr) + 1).Value = fldArr
            Let .Cells(2, i).Resize(UBound(tmpArr, 1) + 1, _
                UBound(tmpArr, 2) + 1).Value = tmpArr
        Next
    End With
    Application.ScreenUpdating = True

End If

MsgBox "Ta da"
End Sub


Function TransposeDim( _
    ByRef v() As Variant, _
    Optional ByRef custStart As Long = 1, _
    Optional ByRef custEnd As Long = 65535) As Variant
' Custom Function to Transpose a 0-based array (v) (MSDN)
' Crop-Functionality and Row-Cap Mods by Nate Oliver
Dim X As Long, Y As Long, custUbound As Long
Dim tmpArr() As Variant
Let custUbound = UBound(v, 2) - custStart + 1
If custUbound > custEnd Then Let custUbound = custEnd
ReDim tmpArr(custUbound, UBound(v, 1))
For X = LBound(tmpArr) To UBound(tmpArr)
    For Y = LBound(tmpArr, 2) To UBound(tmpArr, 2)
        Let tmpArr(X, Y) = v(Y, X + custStart - 1)
    Next Y
Next X
Let TransposeDim = tmpArr
End Function

This, too, was on a normal, yet large, Text file, 'C:\temp\Huge_Text_File.txt' to be exact.

 

[Johnny C]

That was an initial read to verify format

There was a small bit of processing in reading the file, as it was an old 'formatted' test file from a credit card processing agency- i.e. looked pretty on pyjama paper. Half the lines were blank or titles and discarded, and the rest TRIMmed