your e-mail isn't accepting any more messages. It is probably full and need
to be emptied. I send an excel file with the macro about 6 hours ago and got
the following message from your e-mail provider

This message has not yet been delivered. Microsoft Exchange will continue to
try delivering the message on your behalf.

Delivery of this message will be attempted until 5/6/2009 1:55:31 PM
(GMT-05:00) Eastern Time (US & Canada). Microsoft Exchange will notify you if
the message can't be delivered by that time.

Here is the macro

and my comments

The attached XLS file only has a macro in it. The macro will convert a text
file to a CSV file only with the data you want. the macro has 2 options.
One that will open a single file and create a single csv file. Te 2nd option
will convert all the files in a folder. The 2nd method will open all files
that don't have the exntension CSV and create a CSV file with the same
filename containing your results. The code will pen a dialog box so you can
select the file or folder.

I thought CSV is the easiest method to read into MathCad. I don't have
Mathcad installed on my PC right now. I should have Mathcad installed again
in the next week. Hope this macro helps.



Sub GetFiles()

Response = MsgBox("Get one File (Yes)?" & vbCrLf & _
"Get all files in folder (No)", vbYesNo)

If Response = vbYes Then
filetoopen = Application _
.GetOpenFilename()
If filetoopen = False Then
MsgBox ("Cannot Open File - Exiting Macro")
Else
If Right(filetoopen, 1) = "." Then
filetoopen = Left(filetoopen, Len(filetoopen) - 1)
End If
Call FixFile(filetoopen)
End If
Else
Set fd = Application _
.FileDialog(msoFileDialogFolderPicker)
fd.Show
If fd.SelectedItems.Count = 0 Then
MsgBox ("Cannot Open files - Exiting Macr0")
Else
Folder = fd.SelectedItems(1) & "\"
FName = Dir(Folder & "*.*")
Do While FName < ""
'skip csv files
CSV = False
If InStrRev(FName, ".") 0 Then
'get extension
Extension = Mid(FName, InStrRev(FName, ".") + 1)
If UCase(Extension) = "CSV" Then
CSV = True
End If
End If
If CSV = False Then
Call FixFile(Folder & FName)
End If
FName = Dir()
Loop

End If
End If

End Sub

Sub FixFile(ReadFile)

Const ForReading = 1, ForWriting = -2, _
ForAppending = 3

'read 5 column data
'each item in number of character per item
Dim FixedWidthTable(4)
FixedWidthTable(0) = 8 'item count
FixedWidthTable(1) = 13 'UX
FixedWidthTable(2) = 12 'UY
FixedWidthTable(3) = 12 'UZ
FixedWidthTable(4) = 12 'USum
Dim Data(4)

Set fs = CreateObject("Scripting.FileSystemObject")
Set fin = fs.OpenTextFile(ReadFile, _
ForReading, TristateFalse)
Set fout = fs.CreateTextFile _
(Filename:=ReadFile & ".CSV", overwrite:=True)

FoundNode = False
Do While fin.AtEndOfStream < True
ReadData = fin.readline

If FoundNode = True Then
If Len(Trim(ReadData)) = 0 Then
FoundNode = False
Else
StartPos = 1
For i = 0 To UBound(Data)
Data(i) = Trim(Mid( _
ReadData, StartPos, FixedWidthTable(i)))
StartPos = StartPos + FixedWidthTable(i)
Next i
WriteData = Join(Data, ",")
fout.writeline WriteData
End If
Else
If Left(UCase(Trim(ReadData)), 12) = "NODE UX" Then
FoundNode = True
End If
End If

Loop
fin.Close
fout.Close
End Sub






"lonkar" wrote:

i have a file which content the text data followed by numeric data after
every 35 to 40 lines.
data and text is different.file lenth is of 7000 rows.such 2000 files r to
be cleaned.
i need urgent solution to this.
pl help.
send email on