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
"smurray444" wrote:
> 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
>
|
Similar Threads
