Skip to content

Instantly share code, notes, and snippets.

@fabriceleal
Last active February 22, 2024 09:21
Show Gist options
  • Star 31 You must be signed in to star a gist
  • Fork 4 You must be signed in to fork a gist
  • Save fabriceleal/7803969 to your computer and use it in GitHub Desktop.
Save fabriceleal/7803969 to your computer and use it in GitHub Desktop.
Decent enough macro for exporting csvs from Excel.
' http://support.microsoft.com/kb/291296/en-us
' http://superuser.com/questions/130592/how-do-you-force-excel-to-quote-all-columns-of-a-csv-file
' - change integer to long indexing
' http://stackoverflow.com/questions/2524703/save-text-file-utf-8-encoded-with-vba
' - output utf8 content
Sub QuoteCommaExport()
' Dimension all variables.
Dim DestFile As String
Dim FileNum As Integer
Dim ColumnCount As Long
Dim RowCount As Long
Dim fsT As Object
Set fsT = CreateObject("ADODB.Stream")
fsT.Type = 2 'Specify stream type - we want To save text/string data.
fsT.Charset = "utf-8" 'Specify charset For the source text data.
fsT.Open 'Open the stream And write binary data To the object
' Prompt user for destination file name.
DestFile = InputBox("Enter the destination filename" _
& Chr(10) & "(with complete path):", "Quote-Comma Exporter")
' Obtain next free file handle number.
' FileNum = FreeFile()
' Turn error checking off.
On Error Resume Next
' If an error occurs report it and end.
If Err <> 0 Then
MsgBox "Cannot open filename " & DestFile
End
End If
' Turn error checking on.
On Error GoTo 0
' Loop for each row in selection.
For RowCount = 1 To Selection.Rows.Count
' Loop for each column in selection.
For ColumnCount = 1 To Selection.Columns.Count
' Write current cell's text to file with quotation marks.
fsT.WriteText """" & Replace(Selection.Cells(RowCount, ColumnCount).Text, """", """""") & """"
' Check if cell is in last column.
If ColumnCount = Selection.Columns.Count Then
' If so, then write a blank line.
fsT.WriteText vbNewLine
Else
' Otherwise, write a comma.
fsT.WriteText ","
End If
' Start next iteration of ColumnCount loop.
Next ColumnCount
' Start next iteration of RowCount loop.
Next RowCount
' Close destination file.
fsT.SaveToFile DestFile, 2
End Sub
@xib
Copy link

xib commented Aug 6, 2014

To escape values have quote with another quote (e.g.: Length is 3" => "Length is 3""", I replace line 47-48 with this code:

        fsT.WriteText """" & Replace(Selection.Cells(RowCount, ColumnCount).Text, """", """""") & """"

@fabriceleal
Copy link
Author

@xib fixed, thanks

@JlGard
Copy link

JlGard commented Nov 8, 2016

Ok... frustration time. This script worked great for the first few days. Now it errors out with 3004 write to file failed.

No environmental changes I know of. Cut and pasted copy of the original script from here and used it on the same bloody source file.
Still nuttin'.

Anyone have any idea what I may have done to break it?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment