problem with: import text files to excel -- format text

Hi all,

I have some text files in a folder, I have to loop through the folder for all .TXT files and imported to Excel with some formatting.

I have given With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\DATAFLUX\RECONS\CDE\OUTPUT\RCN0151_SO_EQL.txt", Destination:= _
What happens is every Excel File generated from the TXT files has the data of the above file

I would be grateful to the help!! PLease

I have attached my Excel file which got generated by this Macro
Here is my code below :



Sub texttoexcel()
'
' FlatFileImport Macro
' Createded by E.J. Murphy
'
' This macro will convert the Validation Flat Files,
' from text files to Individual Excel workbooks.
'

Dim Path As String 'string variable to hold the path to look through
Dim FileName As String 'temporary filename string variable
Dim tWB As Workbook 'temporary workbook (each in directory)
Dim tWS As Worksheet 'temporary worksheet variable
Dim mWB As Workbook 'master workbook
Dim aWS As Worksheet 'active sheet in master workbook
Dim RowCount As Long 'Rows used on master sheet
Dim uRange As Range 'usedrange for each temporary sheet
Dim NewName As String ' removes .txt from file name
Dim Char As String

'***** Set folder to cycle through *****
Path = "C:\DATAFLUX\RECONS\CDE\OUTPUT\" 'Change as needed

Application.EnableEvents = False 'turn off events
Application.ScreenUpdating = False 'turn off screen updating


Set mWB = Workbooks.Open("C:\DATAFLUX\RECONS\CDE\OUTPUT\template.xlsx")
Set aWS = mWB.ActiveSheet 'set active sheet variable to only sheet in mWB

Range("A1").Select

FileName = Dir(Path & "*.txt", vbNormal) 'set first file's name to filename variable

Do Until FileName = "" 'loop until all files have been parsed

Set tWB = Workbooks.Open(FileName:=Path & FileName) 'open file, set to tWB variable

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\DATAFLUX\RECONS\CDE\OUTPUT\RCN0151_SO_EQL.txt", Destination:= _
Range("A1"))
.Name = "RCN0151_SO_EQL"
.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 = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "~"
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Rows("1:1").Select
With ActiveWindow
.SplitColumn = 1
.SplitRow = 0
End With
ActiveWindow.FreezePanes = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With


Dim rg As Range
Dim blank As Long
Dim i As Long, j As Long
Dim colvalue As Integer
Dim rowvalue As Integer

For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
For j = 1 To Cells(1, Columns.Count).End(xlToLeft).Column

If Cells(i, j).Value = " it uses the data in structured" Then
colvalue = j
rowvalue = i
Exit For
Exit For
Else
Cells(i, j).Interior.PatternColorIndex = xlAutomatic
Cells(i, j).Interior.Color = 5287936
End If
Next j
Next i

For i = rowvalue To Cells(Rows.Count, "A").End(xlUp).Row
For j = colvalue To Cells(1, Columns.Count).End(xlToLeft).Column
Cells(i, j).Interior.PatternColorIndex = xlAutomatic
Cells(i, j).Interior.Color = 15773696
Next j
Next i

' Clear extra data
Range("AH1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

ChDir "C:\DATAFLUX\RECONS\CDE\OUTPUT"


NewName = " "


For i = 1 To Len(FileName)

If Mid(FileName, i, 1) = "." Then
Exit For
Else
NewName = NewName & Mid(FileName, i, 1)
End If
Next i

ActiveWorkbook.SaveAs FileName:=NewName & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False

ActiveWorkbook.Close True

FileName = Dir() 'set next file's name to FileName variable

Loop


Application.EnableEvents = True 're-enable events
Application.ScreenUpdating = True 'turn screen updating back on


End Sub

Some clues:

First build an array of your files:

fPath = "C:\my files\"

'build a list of the files
fName = Dir(fPath & "*.xls")
While fName <> ""

'add fName to the list
I = I + 1
ReDim Preserve fileList(1 To I)
fileList(I) = fName

'get next filename
fName = Dir()
Wend


Now that you have this, I is the number of files and filelist() is the list

Then loop:

For N = 1 to I
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & fpath & filelist(i), Destination:= _
'your code
Next

Robert Flanagan
Add-ins.com LLC
http://www.add-ins.com
Productivity add-ins and downloadable books on VB macros for Excel

Thanks for the heads up. I did not realize that.

Bob

Bob,

I did the code as you suggested, however I'm getting a compile time error When i run on the below statement

Please Login or Register  to view this content.

Bob,

I did the code as you suggested, however I'm getting a compile time error When i run on the below statement

Please Login or Register  to view this content.

Bob,

I did the code as you suggested, however I'm getting a compile time error When i run on the below statement

Please Login or Register  to view this content.

Please try the following. A quote was missing in what you posted. (It was in the code I posted )

Please Login or Register  to view this content.

Robert Flanagan
http://www.add-ins.com
Productivity add-ins and downloadable books on VB macros for Excel

Bob,

Still I hit Run time error '1004' (Application defined or object defined error) : when I run the macro, it stops at the range ...

I know I complain too much but please help me, I'm knew to this VB programming.. Thanks for helping me....

Please Login or Register  to view this content.

It sounds like it doesn't like the file. When the error occurs, you will be taken to that row. Highlight just fpath & filelist(n) and then do from the menus, Debug, Add Watch, and add the watch. The debug window should appear, with the value of the watch evaluated. Is it a valid file name and path? I noticed my code listed xls files for the filelist. Your code had shown txt files. Did you change? Once you stop the code, can you manually add that file to your querytable? If so, record the code and see if the statement is different than what is being used. Perhaps something got dropped off.

can anyone help me with clearing the extra data, each excel sheet generated from the notepad has an extra column that contains all the input data in each rows.
how to select the next column/row from the Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
In other words how to delete the extra row other than we have exported from notepad.

Thanks,
Karthik.