Text files to Excel Files

[iwelcomesu]

Hi All,

Daily I am working with text files with the below fixed format

Identifier1 company name identifer 2 identifier 3
---------- --------------- ---------- ----------
xxxxxxx xxxxxxxxxxxxxxx xxxxxxxxxx xxxxxxxxx
xxxxxxx xxxxxxxxxxxxxxx xxxxxxxxxx xxxxxxxxx
xxxxxxx xxxxxxxxxxxxxxx xxxxxxxxxx xxxxxxxxx
xxxxxxx xxxxxxxxxxxxxxx xxxxxxxxxx xxxxxxxxx

these text files are need to convert to excel files with fixed format and save the excel file with same name available for text file (ex. xxx1234.txt to xxx1234.xls) and finally consolidate all the data that are available in converted excel files to one consolidate excel file. text files are more than 100 daily. is it possible to automate this activity by VBA code, i am very very poor at codeing part. please help in this regard. all the text files are saved one folder only.

Regards,
Hari

[Rob342]

Hari,
Please refer to link below might help with what you need.

http://www.vbaexpress.com/forum/showthread.php?t=35726&highlight=cvs+files

[iwelcomesu]

Hi Rob,
Thanks for quick reply, but my request is to convert the textfiles to excelfiles first, and split the data in excel, and save the excelfile with the same name as txt file have.

Regards
Hari

[Rob342]

iwelcomesu

Post a copy of your workbook and explain clearly what you want to do and i will try and help if i can ok.

[GTO]

In furtherance of Rob's suggestion, I would add to zip a couple of the text files and attach. If sensitive info, provide fake data with the same layout (delimits).

[iwelcomesu]

Hi GTO and ROB,

here the sample text file and converted to the excel file with required format and then consolidate all the data that contains in excel files.

Regards,
Hari

[GTO]

...If sensitive info, provide fake data with the same layout (delimits).

If you are sure that the data is actually layed out in the exact same manner... here's a start (basically a recording).

Sub Macro2()
Dim sht As Worksheet, qry As QueryTable
Dim Path As String, FileName As String

Path$ = ThisWorkbook.Path & "\"
FileName$ = "Sample.txt"

Set sht = ActiveSheet
Set qry = sht.QueryTables.Add("TEXT;" & Path$ & FileName$, Range("A2"))

With qry
.Name = "Test"
.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 = 3
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(9, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
.Delete
End With
End Sub

See if that grabs one file succesfully.

[Rob342]

Hari / Mark

You beat me too it.
Another way if you want


Sub ImportTxt()
ChDir "C:\"
Workbooks.OpenText Filename:="C:\Sample.txt", Origin:=437, StartRow:= _
1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(7, 1), Array(100 _
, 1), Array(113, 1)), TrailingMinusNumbers:=True
End Sub



Rob

[iwelcomesu]

HI Team,

Thanks for Your support, acutal my requirements are
Step 1. One Folder contians all the text files (100+) all these files are need to convert to excel files with same name text files contians (find sample text file in this post)

Step 2. all the excel files data should be (text to columns) with fixed width

Setp 3. Consolidate all the excel files into one sheet, and delete empty rows with in it.

can any one help in this regard.

Regards
Hari

[shrivallabha]

I had this code which I had used for combining some files. I had to change it a bit.
Private Sub ImportTextFiles_Click()
Dim RowCounter As Long
Dim startrow As Long
With Application.FileSearch
.NewSearch
.LookIn = "My Documents" 'Specify your path here.
.SearchSubFolders = False
.Filename = "*.TXT*"
.FileType = msoFileTypeAllFiles
startrow = 5
If .Execute() > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For i = 1 To .FoundFiles.Count
Open .FoundFiles(i) For Input As #1
RowCounter = 1
Do While Not EOF(1)
Line Input #1, Data
Select Case RowCounter
Case 1, 2
Case Else
Cells(startrow, 1).Value = Left(Data, 7)
Cells(startrow, 2).Value = Mid(Data, 8, 18)
Cells(startrow, 3).Value = Mid(Data, 27, 9)
Cells(startrow, 4).Value = Mid(Data, 36, 7)
startrow = startrow + 1
End Select
RowCounter = RowCounter + 1
Loop
Close #1
Next i
Call Cleans
Else
MsgBox "There were no files found. Please Check"
End If
End With
End Sub
Sub Cleans()
'Thanks to mdmackillop
Dim Cel As Range
For Each Cel In ActiveSheet.UsedRange
Cel.Value = Trim(Cel.Value)
Next
End Sub

Not all work is mine. I had taken help from this forum at that time. It will be pertinent to note that this will work upto Excel version 2003 as Application.Filesearch has been removed in Versions 2007 onwards.

I have attached the revised file as well.

[RonMcK]

Here's a variation on Rob's suggestion of using the OpenText method:
Workbooks.OpenText Filename:=MyFilename & SrcExten, _
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True

In my project, I had tab delimiters, you probably wnat to change to space delimiters, substituting Space:=True for my Tab:=True.

The other items that need to be added to shrivallabha's example would be code to open your blank target XL files and then where you close #1 (the source text file), to save your target XL file, followed by some code to copy the data in you target XL file into an XL file consolidating your data. Once you've pasted that, then you can close the current target XL file and loop back to open the next source Txt and target XL files, and repeat the process. You need code between the "If .execute ... " and the "For i = 1 to .FilesFound.Count" lines that opens your consolidated XL file, and code near the bottom of the program (after looping through all the source files) that saves and closed the consolidated XL file.

[Kenneth Hobs]

Is your TXT file really formatted that poorly? The second field has multiple tab characters with no space character so the OpenText method imports it as two fields.

If you use the QueryTables method with fixed width, you will still need some tweaks to remove the tab characters and prefixed and suffixed space characters. Even so, you still lose the numeric formatting with leading zeros (see cell c8 in shrivallabha's xls example). This method does not import the last two fields either.

Reading the file as in shrivallabha's code, is probably the best route but you still have a leading zero issue. Using the FileSearch method will not work in Excel 2007+ so you may want to use a method like Dir() if you will upgrade your Excel version sometime.

Here is an example of the Dir() method less the importing, saving as xls and creation of master.xls with all data.

Sub TXT2XLSFilesAndMaster()
Dim FileName As String, Filespec As String, FileFolder As String
Dim wb As Workbook, xlsFile As String

FileFolder = ThisWorkbook.Path & "\"
Filespec = FileFolder & "*.txt"

FileName = Dir(Filespec)
If FileName = "" Then Exit Sub

' Loop until no more matching files are found
Do While FileName <> ""
xlsFile = FileFolder & GetBaseName(FileName) & ".xls"
If Not FileExists(xlsFile) Then
'do the import here...
End If
FileName = Dir()
Loop
End Sub

Function FileExists(sFilename As String) As Boolean
Dim fso As Object, tf As Boolean
Set fso = CreateObject("Scripting.FileSystemObject")
tf = fso.FileExists(sFilename)
Set fso = Nothing
FileExists = tf
End Function

Function GetBaseName(Filespec As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
GetBaseName = fso.GetBaseName(Filespec)
End Function

[iwelcomesu]

Hi Hobs,

Can you please suggest where I need to place my folder path for text files, and excel files which are converted by macro in above code.

Regards,
Hari

[Kenneth Hobs]

I can't tell you where you should put files. I can show you what I assumed.

I set the path to the TXT files to be that of the workbook with the macro code as shown here:
FileFolder = ThisWorkbook.Path & "\"
Filespec = FileFolder & "*.txt"

The filename for the XLS file that I built was based on the FileFolder path as shown here:
xlsFile = FileFolder & GetBaseName(FileName) & ".xls"

Just change the FileFolder above to be whatever you like if it is not the same as the folder for the TXT files where FileFolder points to.

[iwelcomesu]

Hi Hobs,

very much thanksful for in detail explanation, say for example i given path for my text files as FileFolder = "C:\text" code is running but output is not generating. copied all the required text files ino this path, please let me know if any thing I missed.

Regards,
Hari

[Kenneth Hobs]

Did you add the trailing backslash?

FileFolder = "C:\text\"

[iwelcomesu]

Did you add the trailing backslash?

FileFolder = "C:\text\"
I tried with and without trailing backslash but it is not working. it does not produce any output.

Regards,
Hari

[Kenneth Hobs]

You have to add the part where it does the import as shown in my comment.
'do the import here...


The other posts showed two methods. If you want to add that part, tell me which method you liked best.

[iwelcomesu]

HI Hobs,

let me show you the code that I am useing:

Sub TXT2XLSFilesAndMaster()
Dim FileName As String, Filespec As String, FileFolder As String
Dim wb As Workbook, xlsFile As String

FileFolder = "C:\text"
Filespec = FileFolder & "*.txt"

FileName = Dir(Filespec)
If FileName = "" Then Exit Sub

' Loop until no more matching files are found
Do While FileName <> ""
xlsFile = FileFolder & GetBaseName(FileName) & ".xls"
If Not FileExists(xlsFile) Then
FileFolder = "C:\text"
End If
FileName = Dir()
Loop
End Sub

Function FileExists(sFilename As String) As Boolean
Dim fso As Object, tf As Boolean
Set fso = CreateObject("Scripting.FileSystemObject")
tf = fso.FileExists(sFilename)
Set fso = Nothing
FileExists = tf
End Function

Function GetBaseName(Filespec As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
GetBaseName = fso.GetBaseName(Filespec)
End Function


---> bolded ones are modified by me, please let me know the code which it imports and whrere I need to place the code in above code.

Thanks for more help !

Regards,
Hari

[Kenneth Hobs]

Hari, please use VBA tags when posting code.

I used Rob's method to create the XLS files but there is a problem with your TXT file format as I explained before so Excel will want you delimit it when you open the XLS file.

This is just half of what you asked. For importing to one master file, the XLS files should be created properly. There are several methods to import XLS data to a master XLS. Another method is to do as shrivallabha did and import from the txt files instead.

Sub TXT2XLSFilesAndMaster()
Dim FileName As String, Filespec As String, FileFolder As String
Dim wb As Workbook, xlsFile As String, txtFile As String

FileFolder = ThisWorkbook.Path & "\"
Filespec = FileFolder & "*.txt"

FileName = Dir(Filespec)
If FileName = "" Then Exit Sub

' Loop until no more matching files are found
Do While FileName <> ""
xlsFile = FileFolder & GetBaseName(FileName) & ".xls"
txtFile = FileFolder & FileName
If Not FileExists(xlsFile) Then
'Start the import here...
ImportTxt txtFile
'Save the imported file as xlsFile and close it.
ActiveWorkbook.SaveAs xlsFile
ActiveWorkbook.Close False
'End the import here...
End If
FileName = Dir()
Loop
End Sub

Sub Test_ImportTxt()
ImportTxt "X:\FileFolder\SaveAsXLSandMaster\Sample.txt"
'ImportTxt thisworkbook.Path & "\Sample.txt"
End Sub

Sub ImportTxt(sFile As String)
Workbooks.OpenText FileName:=sFile, Origin:=437, StartRow:= _
1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(7, 1), Array(100 _
, 1), Array(113, 1)), TrailingMinusNumbers:=True
End Sub

[iwelcomesu]

Hi Hobs,

Thanks You very much for your patience and suggestions, this code is working fine, but when text files are converting to excel files data was unable to select text mode, please find attached screenshot for your reference.
Workbooks.OpenText FileName:=sFile, Origin:=437, StartRow:= _
1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(7, 1), Array(100 _
, 1), Array(113, 1)), TrailingMinusNumbers:=True

[Kenneth Hobs]

Yes, that is what I said would happen. Your data is not really set at a fixed width. Since it is not consistent, you see that scenario. While we could fix it for the sample.txt that you posted, again, is that really how your files are setup or did you obfuscate your data and add the tab characters? Tab characters do not make for a fixed width formatted file. Open your sample.txt file in notepad and use your right arrow key on the data row 3 to see what I mean.

When you do Data > From Text for sample.txt in Excel 2010, you get that same dialog. When setting the fixed widths, the final product is not what you would want. As I said above, we can fix it for you but I fear that it may be a wasted effort if your real data does not follow that same structure.

[iwelcomesu]

Hi Hobs,

What ever you said that is correct, I tested all my original text files, all the text files are in fixed width only, and they are converted with fixed width format, problem is data is converted with fixed width without text format, it this should fix my problem will solved, due to without text format this data is invalid.

Thanks for your help.
Have a nice weekend.

Regards,
Hari

[Kenneth Hobs]

Change the SaveAs line of code to add the xls file type as shown here to resolve the save type issue.

ActiveWorkbook.SaveAs xlsFile, xlWorkbookNormal
The full code for the Sub that uses it is:
Sub TXT2XLSFilesAndMaster()
Dim FileName As String, Filespec As String, FileFolder As String
Dim wb As Workbook, xlsFile As String, txtFile As String

FileFolder = ThisWorkbook.Path & "\"
Filespec = FileFolder & "*.txt"

FileName = Dir(Filespec)
If FileName = "" Then Exit Sub

' Loop until no more matching files are found
Do While FileName <> ""
xlsFile = FileFolder & GetBaseName(FileName) & ".xls"
txtFile = FileFolder & FileName
If Not FileExists(xlsFile) Then
'Start the import here...
ImportTxt txtFile
'Save the imported file as xlsFile and close it.
ActiveWorkbook.SaveAs xlsFile, xlWorkbookNormal
ActiveWorkbook.Close False
'End the import here...
End If
FileName = Dir()
Loop
End Sub

[iwelcomesu]

Hi Hobs,

Thanks a lot for your valuable time spent on this issue. My problem is solved. I will meet you with one more issues soon......:hi:

Regards
Hari
</IMG>