smurray444
New Member
- Joined
- Nov 21, 2005
- Messages
- 48
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
Just to add that I didn't write this code myself! I'm useless at VBA; this was taken from the MS website and adapted slightly by someone who knows far more about VBA than me!
If you would be able to make the amendments I've suggested, then I'd be very grateful. Also if you need any further clarification then please do not hesitate to ask me.
Many thanks for your help and time,
Steve
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
Just to add that I didn't write this code myself! I'm useless at VBA; this was taken from the MS website and adapted slightly by someone who knows far more about VBA than me!
If you would be able to make the amendments I've suggested, then I'd be very grateful. Also if you need any further clarification then please do not hesitate to ask me.
Many thanks for your help and time,
Steve