Thread
:
help with macro to read and sort data from multiple text files
View Single Post
#
2
Posted to microsoft.public.excel.programming
joel
external usenet poster
Posts: 9,101
help with macro to read and sort data from multiple text files
Below I added more comments to previous code and added Constants for sheet
names. if you need help email me at
. Explain in detail
the problems. You said previously you had code to due the sorting so I
didn't add any sort code. Just reading of the text files and appending the
sorted data to the sumary sheet.
Send me samples of the text files or the text file data read into sheet1 of
your spreadsheet.
Sub GetTextFiles()
Const MyPath = "D:\temp"
Const ReadWorkSheet = "Sheet1"
Const SortedWorkSheet = "Sheet2"
Const SummaryWorkSheet = "Sheet3"
Set fs = Application.FileSearch
With fs
.LookIn = MyPath
.Filename = "*.txt"
End With
If fs.Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) 0 Then
For i = 1 To fs.FoundFiles.Count
With Worksheets(ReadWorkSheet).QueryTables. _
Add(Connection:="TEXT;" + fs.FoundFiles(i), _
Destination:=Worksheets(ReadWorkSheet).Range("A1") )
.Name = fs.FoundFiles(i)
.FieldNames = True
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileCommaDelimiter = True
.TextFileColumnDataTypes = _
Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'copy sheet 2
'check row 1 for last ocupied cell
LastColumn2 = Worksheets(SortedWorkSheet). _
Cells(1, Columns.Count).End(xlToLeft).Column
'check column 1 (A) for last row
Lastrow2 = Worksheets(SortedWorkSheet). _
Cells(Rows.Count, 1).End(xlUp).Row
'check row 1 for last occupied column
PasteColumn = Worksheets(SummaryWorkSheet). _
Cells(1, Columns.Count).End(xlToLeft).Column
'add one to paste column except if pasting in column A
If PasteColumn = 1 Then
If Not IsEmpty(Worksheets(SummaryWorkSheet).Cells(1, 1)) Then
PasteColumn = 2
End If
Else
PasteColumn = PasteColumn + 1
End If
'get Range of data on worksheet with sorted data
Worksheets(SortedWorkSheet).Activate
Set CopyRange = Worksheets(SortedWorkSheet). _
Range(Cells(1, 1), Cells(Lastrow2, LastColumn2))
'Paste data to the right of previous data
Set PasteRange = Worksheets(SummaryWorkSheet). _
Cells(1, PasteColumn)
CopyRange.Copy Destination:=PasteRange
'delete pevious data read from text file
Set MyQueryTable = Worksheets(ReadWorkSheet).QueryTables
For j = 1 To (MyQueryTable.Count - 1)
MyQueryTable(j).Delete
Next j
Worksheets(ReadWorkSheet).Activate
Worksheets(ReadWorkSheet).Cells.Select
Selection.ClearContents
Worksheets(ReadWorkSheet).Cells(1, 1).Select
Next i
Else
MsgBox "There were no files found."
End If
End Sub
" wrote:
Joel,
This is regarding my post on " microsoft.public.excel.programming"
3/16/07 with above subject. I am adapting your VBScript to work for
me
but still have some issues that I have not been able to resolve. I
would like to send you my files (.xls, .dat), if you give an email
address, so
you can help me out?
thank you very much for your help
Jay
Reply With Quote
joel
View Public Profile
Find all posts by joel