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