'==============Start of Code =======================
'Exports the Current worksheet
Public Sub export_worksheet()
Dim sh As Worksheet
Set sh = Excel.ActiveSheet
Dim fn As String
fn = "\" & sh.Name & ".csv" 'uses the worksheetname as the filename
Write_Sheet fn, sh.Name
End Sub
'-----------------------------
' This will write a worksheet to a CSV
'-----------------------------
Public Sub Write_Sheet(file_name As String, sheet_name As String)
Dim epath As String
epath = Excel.Workbooks(1).Path & file_name
Dim fso As Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Dim ofile As Scripting.TextStream
Set ofile = fso.CreateTextFile(epath)
Dim wks As Worksheet
Set wks = Worksheets(sheet_name)
Dim mc As Integer
Dim mr As Integer
mc = wks.Range("A1").End(xlToRight).Column 'This only works if there are no blanks to the right
mr = wks.Range("A1").End(xlDown).Row 'This only works if the data set is consistent down
For lr = 1 To mr
For lc = 1 To mc
If lc = mc Then
ofile.WriteLine """" & wks.Cells(lr, lc).Value & """"
Else
ofile.Write """" & wks.Cells(lr, lc).Value & ""","
End If
Next
Next
'finish close all connections
ofile.Close
Set fso = Nothing
Set ofile = Nothing
Exit Sub
'if error handler
handler:
End Sub
'========================== End of Code =====================
This code uses the scripting .filesystemobject and writes out a text stream to a file while adding the commas and the quotes. It's a very basic script, there can be a lot done to improve it.
