Hi All,

I use a code in VBA that will extract text from an excel worksheet.
I use the UsedRange option to get the row and colums with text.
Recently I had a worksheet that had 14434 rows of which maybe 20 were
with text.
The code kept cycling until it reached row 14434.
Is there a way to get only the lines with text?

Public Function Excel2Text(sInputFile As String, sOutputFile As
String, Sep As String)

'Sep:=";"
Dim oAppl As Excel.Application
Dim oWorkbook As Excel.Workbook
Dim oSh As Object
Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String
Dim sTempName As String

On Error GoTo EndFunction:
Set oAppl = New Excel.Application
Set oWorkbook = oAppl.Workbooks.Open(Tempdir & sInputFile, False,
True)

oAppl.Visible = False
oAppl.ScreenUpdating = False
FNum = FreeFile

sTempName = Mid$(sOutputFile, 1, InstrRev(sOutputFile, ".", -1)) &
"TXT"
Open geheugen.gTempDirZoekWoorden & sTempName For Output Access Write
As #FNum

For Each oSh In oWorkbook.Sheets

With ActiveSheet.UsedRange
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With

For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = Chr(34) & Chr(34)
Else
CellValue = Cells(RowNdx, ColNdx).Text
End If
WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine
Next RowNdx
Next

EndFunction:
On Error GoTo 0

Close #FNum

oAppl.Quit
Set oWorkbook = Nothing

End Function


Regards
Marco