import multiple files larger than 65536

[Matt S]

With the help of this board, I was able to find the following link to import
a file larger than 65536 rows:
http://support.microsoft.com/default.aspx?scid=kb;en-us;120596

It works great, but now my problem is that I have multiple files I'd like to
perform this on and combine them into one file. At work, I age samples for
50 hours and collect data every second. Sometimes something goes wrong with
the aging and I have to break the test up into two files.

Can anyone help me modify the code to handle the import of multiple files?
Any help would be appreciated!

Thanks!
Matt

 

[Joel]

This ccode probaly will need mdoficiation because it is based on the
microsoft sample code. the code will open all "*.txt" files in the directory
Folder. Modify Folder as necessary.



Sub LargeFileImport()
'Dimension Variables
Dim ResultStr As String
Dim FileName As String
Dim FileNum As Integer
Dim RowCount As Long
Dim colcount As Long
'Create A New WorkBook With One Worksheet In It
set newbk = Workbooks.Add(template:=xlWorksheet)
'Set The RowCount to 1
RowCount = 1

Folder = "C:\Temp\"

FName = Dir(Folder & "*.txt")
Do While FName <> ""

'Open Text File For Input
Open (Folder & FName) For Input As #FileNum
'Turn Screen Updating Off
Application.ScreenUpdating = False
'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 " & _
RowCount & " 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
Cells(RowCount, "A").Value = "'" & ResultStr
Else
Cells(RowCount, "A").Value = ResultStr
End If

'For Excel versions before Excel 97, change 65536 to 16384
If RowCount = 65536 Then
'If On The Last Row Then Add A New Sheet
with newbk
.Sheets.Add after:=.sheets(sheets.count)
end with
RowCount = 1
Else
'If Not The Last Row Then Go One Cell Down
RowCount = RowCount + 1
End If
'Start Again At Top Of 'Do While' Statement
Loop
'Close The Open Text File
Close
FName = Dir()
Loop
'Remove Message From Status Bar
Application.StatusBar = False
End Sub

 

[Matt S]

Thanks so much Joel! I'm gonna sit here and apply it to my code and get back
to you if it works out. I think I see what you did here.

Thanks!
Matt