View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Tim Williams Tim Williams is offline
external usenet poster
 
Posts: 1,588
Default Save as txt - extra carriage return

For Each rRow In sh.Range("A1:A" & Range("A65536").End(xlUp).Row)

If sOutput<"" then
sOutput = sOutput & vbNewLine
end if

For Each rCell In rRow.Cells
sOutput = sOutput & rCell.Text
Next rCell

Next rRow

--
Tim Williams
Palo Alto, CA


"Steph" wrote in message
...
Hi everyone. The below code taskes a worksheet and saves it as a txt

file.
There is a loop in there (sOutput = sOutput & vbNewLine) that adds a
carriage return. I am having a problem with my txt file in that there is

1
extra carriage return at the bottom that I can't get rid of, and it's
messing up my database. And ideas on how I can get rid of it, or maybe

edit
the loop so it doesn't add a carriage return when the last line is

written?
Thanks in advance!!


Sub Saveastxt()
Dim sh As Worksheet
Dim rRow As Range
Dim rCell As Range
Dim sOutput As String
Dim lFnum As Long
Dim sFname As String

Set sh = ActiveWorkbook.Worksheets("Sheet1")

For Each rRow In sh.Range("A1:A" & Range("A65536").End(xlUp).Row)
For Each rCell In rRow.Cells
sOutput = sOutput & rCell.Text
Next rCell
sOutput = sOutput & vbNewLine
Next rRow
'*******remove extra blank row at bottom of text file - doesn't remove
last carriage return!!
sOutput = Left(sOutput, Len(sOutput) - 2)

lFnum = FreeFile
sFname = "\\server\folder\file.txt"

Open sFname For Output As lFnum

Print #lFnum, sOutput

Close lFnum
ActiveWorkbook.Close False

End Sub