gistfile1.vb

' 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