Adapting VBA Code

[smurray444]

Dear all,

I have some VBA code which reads in a long text file into Excel 2007, and
when it reaches the bottom of the worksheet creates a new one and carries on
importing until reaching the end of the file.

However, it only reads in a single file at a time. I was wondering if it
would be possible to automate the reading in of all of my 29 files in one go
(where the code increments the file name by one each time from 1961 up to
1990): the file name format is out_lpj_year1961.txt, out_lpj_year1962.txt,
out_lpj_1963.txt up to out_lpj_1990.txt.

Each text file is composed of 3 columns; for the first file to be imported
(out_lpj_year1961.txt) I need all 3 columns going into Excel. Yet for the
rest, I need only the third column being inserted in next to the existing
column (i.e. the row count shouldn't increase, only the number of columns).
The total column count should equal 31 (29 files of which the 3rd column from
each one is imported, plus the extra two from the 1st file).

The code as it stands is:

Attribute VB_Name = "Module1"
'"Text Files (*.txt),*.txt
Option Explicit
Sub LargeFileImport()
Const MaxRows As Long = 1048576
'Dimension Variables
Dim ResultStr As String
Dim FileName As String
Dim FileNum As Integer
Dim Counter As Double
Dim num() As Single
Dim v As Variant, i As Long, j As Long
Dim s As String, sChr As String
Dim rw As Long
'Ask User for File's Name
FileName = Application.GetOpenFilename( _
FileFilter:="Text Files (*.txt),*.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
s = ""
rw = 1
Do While Seek(FileNum) <= LOF(FileNum)
'Display Importing Row Number On Status Bar
' Application.StatusBar =
Debug.Print "Importing Row " & _
Counter & " of text file " & FileName
'Store One Line Of Text From File To Variable
ResultStr = Input(1000, #FileNum)
'Store Variable Data Into Active Cell
For i = 1 To Len(ResultStr)
sChr = Mid(ResultStr, i, 1)
If Asc(sChr) = 10 Then
If Len(Trim(s)) > 0 Then
v = Split(Application.Trim(s), " ")
ReDim num(LBound(v) To UBound(v))
For j = LBound(v) To UBound(v)
num(j) = CSng(v(j))
Next
Cells(rw, 1).Resize(1, _
UBound(v) - LBound(v) + 1) = num
rw = rw + 1
s = ""
Erase v
If rw > MaxRows Then
ActiveWorkbook.Sheets.Add
rw = 1
End If
End If
Else
s = s & sChr
End If
Next
'Increment the Counter By 1
Counter = Counter + 1
' If Counter > 1E+307 Then
' Exit Do
' End If
'Start Again At Top Of 'Do While' Statement
Loop
'Close The Open Text File
Close
If Len(Trim(s)) > 0 Then
v = Split(Application.Trim(s), " ")
ReDim num(LBound(v) To UBound(v))
For j = LBound(v) To UBound(v)
num(j) = CSng(v(j))
Next
Cells(rw, 1).Resize(1, _
UBound(v) - LBound(v) + 1) = num
rw = rw + 1
s = ""
Erase v
If rw > 1048576 Then
ActiveWorkbook.Sheets.Add
rw = 1
End If
End If
'Remove Message From Status Bar
Application.StatusBar = False
End Sub



I have since obtained some code which should open the files one by one,
import the data, delimit on spaces, and delete the first two columns. There
are three issues with this:

1) I'm not sure whether it will import all 3 columns for the first file

2) The files I'm importing into Excel 2007 are large (>2m rows), so the
original code was designed to 'overspill' the import onto subsequent
worksheets when it doesn't fit onto the first sheet. Does the second code
still do this?

3) I am unable to test the code because when I attempt to run it, I get
'runtime error 52: bad file name or number'. However, I type in the full file
path as suggested in the code (shown below) and have tried both ommitting and
including the '.txt' extension.

The code:

Sub Macro6()
Range("A1").Select
d = 1
For fnum = 1961 To 1990
fname = "TEXT;C:\....ur path ....\out_lpj_year" & fnum & ".txt"
With ActiveSheet.QueryTables.Add(Connection:=fname, Destination:=Cells(1, d))
..Name = "test" & i
..FieldNames = True
..RowNumbers = False
..FillAdjacentFormulas = False
..PreserveFormatting = True
..RefreshOnFileOpen = False
..RefreshStyle = xlInsertDeleteCells
..SavePassword = False
..SaveData = True
..AdjustColumnWidth = True
..RefreshPeriod = 0
..TextFilePromptOnRefresh = False
..TextFilePlatform = 437
..TextFileStartRow = 1
..TextFileParseType = xlDelimited
..TextFileTextQualifier = xlTextQualifierDoubleQuote
..TextFileConsecutiveDelimiter = True
..TextFileTabDelimiter = False
..TextFileSemicolonDelimiter = False
..TextFileCommaDelimiter = False
..TextFileSpaceDelimiter = True
..TextFileColumnDataTypes = Array(2, 2, 2)
..TextFileTrailingMinusNumbers = True
..Refresh BackgroundQuery:=False
End With
If d = 1 Then
d = d + 3
Else
Cells(1, d).EntireColumn.Delete shift:=xlToLeft
Cells(1, d).EntireColumn.Delete shift:=xlToLeft
d = d + 1
End If
Next
End Sub

Sorry it's been a long message. I'd really appreciate it if anyone is able
to offer suggestions and/or adapt/join together the code (if necessary).

Many thanks for your help and time,
Steve

 

[Duke Carey]

Rather than address your specific quertion, I'll ask the question about
approach:

What about using the text driver from the Jet database engine or the 2007
Access engine to query the text files? You can get the top 1M rows from the
first file and put them into your first worksheet, then get the next million
rows & put them into the 2d sheet, etc.

Once that paort is done, query each of the subsequent files but pull in only
the 3rd column from each