Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adapting VBA Code
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adapting VBA Code
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Adapting MAX function | Excel Worksheet Functions | |||
Please Help Adapting this Macro | Excel Programming | |||
Adapting an array formula | Excel Programming | |||
Adapting some code | Excel Programming | |||
adapting the findnext function | Excel Programming |