save an excell file in CSV

Post date: Feb 1, 2011 5:35:28 PM

Sub CreateCSV()

Dim rCell As Range

Dim rRow As Range

Dim sOutput As String

Dim sFname As String, lFnum As Long

Dim a As String

a = Range("E2").Value

If a = "" Then End

If a <> "" Then

'Open a text file to write

sFname = "C:\FTT\" & a & "_FTT.csv"

lFnum = FreeFile

On Error Resume Next

MkDir "C:\FTT"

On Error GoTo 0

Open sFname For Output As lFnum

'Loop through the rows'

For Each rRow In ActiveSheet.UsedRange.Rows

'Loop through the cells in the rows'

For Each rCell In rRow.Cells

sOutput = sOutput & rCell.Value & ";"

Next rCell

'remove the last comma'

sOutput = Left(sOutput, Len(sOutput) - 1)

'write to the file and reinitialize the variables'

Print #lFnum, sOutput

sOutput = ""

Next rRow

'Close the file'

Close lFnum

MsgBox "Export Completed ! " & Chr(13) & _

Chr(13) & _

"path : " & sFname, 0 + 64, "Export FTT to CSV"

End If

End Sub