A Working VBA that exports excel to csv UTF8

Question

This topic has concluded: I'm a total beginner and I can work this - if you need to tweak simple stuff you might want to read all thats been said here...

The solution is copied at the bottom of this post...

Original Task: This is one of the better excel to CSV in UTF8 solutions i was able to find out there. Most either want to install plugins or needlessly complicate the process. And there are many of them.

One issue was already solved. (how to export rows in use instead of pre-defined number)

What remains is to tweak some stuff.

Case Excel
A1=Cat, B1=Dog
A2=empty B2=Empty
A3=Mouse B3=Bird

Current script exports

Cat,Dog

Mouse,Bird

Whats needed is

"Cat","Dog"
,
"Mouse","Bird"

Code:

Public Sub WriteCSV()
Set wkb = ActiveSheet
Dim fileName As String
Dim MaxCols As Integer
fileName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")

If fileName = "False" Then
End
End If

On Error GoTo eh
Const adTypeText = 2
Const adSaveCreateOverWrite = 2

Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Charset = "UTF-8"
BinaryStream.Type = adTypeText
BinaryStream.Open

For r = 1 To 2444
s = ""
C = 1
While Not IsEmpty(wkb.Cells(r, C).Value)
s = s & wkb.Cells(r, C).Value & ","
C = C + 1
Wend

If Len(s) > 0 Then
s = Left(s, Len(s) - 1)
End If
BinaryStream.WriteText s, 1

Next r

BinaryStream.SaveToFile fileName, adSaveCreateOverWrite
BinaryStream.Close

MsgBox "CSV generated successfully"

eh:

End Sub

SOLUTION: (Note you can pre define the number of rows by replacing wkb.UsedRange.Rows.Count with a number - same with columns, and do other minor adjustments should you need to.) If you want a pre defined file path put in the empty quotes after fileName = Application.GetSaveAsFilename(""

Public Sub WriteCSV()
Set wkb = ActiveSheet
Dim fileName As String
Dim MaxCols As Integer
fileName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")

If fileName = "False" Then
End
End If

Const adTypeText = 2
Const adSaveCreateOverWrite = 2

Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Charset = "UTF-8"
BinaryStream.Type = adTypeText
BinaryStream.Open

For r = 1 To wkb.UsedRange.Rows.Count
    S = ""
    sep = ""

    For c = 1 To wkb.UsedRange.Columns.Count
        S = S + sep
        sep = ","
        If Not IsEmpty(wkb.Cells(r, c).Value) Then
            S = S & """" & wkb.Cells(r, c).Value & """"
        End If
    Next

    BinaryStream.WriteText S, 1

Next r

BinaryStream.SaveToFile fileName, adSaveCreateOverWrite
BinaryStream.Close

MsgBox "CSV generated successfully"

eh:

End Sub

that doesn't work. You have to do "For r = 1 To wkb.UsedRange.Rows.Count" , any way you can post it so i can accept the answer and resolve the thread. — helena4, Oct 16 '14 at 13:34
You're right. I wrote out of mind because I had no Excel to test it. But I will follow your invitation :-) — Fratyx, Oct 16 '14 at 13:36
Do you know how to tweak it so it doesn't add the "," after the second column it exports? if you export 2 columns with a=dog and b+cat you get: dog,cat, i want to get dog,cat — helena4, Oct 23 '14 at 15:41
I put the code into my post. I think there are empty lines and so the `Left` function fails. You should remove the `On Error` statement for development to see where your code crashes. — Fratyx, Oct 27 '14 at 06:13

Fratyx · Accepted Answer · 2014-11-21T13:42:14.333

1

Use:

For r = 1 To wkb.UsedRange.Rows.Count

Update

Use this to remove the trailing commas in your output. (see comments)

If Len(s) > 0 Then
    s = Left(s, Len(s) - 1)
End If
BinaryStream.WriteText s, 1

Update 2

I hope this will work as you expect. I changed the way the commas are added and added a the variable sep (separator) for that. Maybe you want to declare it in function header. If you have a fixed count of row and you know the count you can replace the wkb.UsedRange.Columns.Count expression. As you see inside quotes you have to quote a quote what makes 4 quotes alltogether (I don't know if this sentence makes sense.) :-)

For r = 1 To wkb.UsedRange.Rows.Count
    s = ""
    sep = ""

    For c = 1 To wkb.UsedRange.Columns.Count
        s = s + sep
        sep = ","
        If Not IsEmpty(wkb.Cells(r, c).Value) Then
            s = s & """" & wkb.Cells(r, c).Value & """"
        End If
    Next

    BinaryStream.WriteText s, 1
Next r

And take a deep breath when you finally did it.

edited Nov 21 '14 at 13:42

answered Oct 16 '14 at 13:36

Fratyx

5,717
1
12
22

This is turning into a marathon of pain... Now i have cat,dog empty row mouse,bird And I have to assure they are all cited and that empty rows come up as a single coma ",". To end up with "cat","dog" , "mouse","bird" The first i have to do because some of the text has actual comas in it and its more of a pain to cite just those, so we might as well do em all. The coma he didn't tell me why. This is the last of it - i promise, one more requirement out of him and ill take the two day drive and keep punching him in the face until he fixes his crappy parser to deal with it. – helena4 Nov 21 '14 at 12:25
Thx for the help so far btw, (i was way away for a while) I imagine citing everything is going to be easy, if the empty rows crap is hard you can drop it and I'll see what I can do about it. This could probably help, but I couldn't understand it well enough to adapt. http://www.excel-easy.com/vba/examples/write-data-to-text-file.html Or we can do & CHR(34) but I probably need two hours to figure out where exactly to insert it. Will look into it after work. – helena4 Nov 21 '14 at 13:08
Jesus, you have no idea how many "solutions" I've tried to even get to this close one and then have you tweak it. Finally. There are other working solutions - some coders have written some working plugins for it, but a copy paste VBA always beats any install in terms of usability. – helena4 Nov 21 '14 at 15:46
It's been a pleasure ;-) – Fratyx Nov 23 '14 at 12:05

score 0 · Answer 2 · answered Nov 21 '14 at 13:12

I assume from your comments that you want each cell surrounded by quotes and separated by commas including the blank cells (this is a normal CSV).

The code below uses ForEach to traverse the used range of the spreadsheet.

Public Sub WriteCSV()
Set wkb = ActiveSheet
Dim fileName As String
Dim MaxCols As Integer
fileName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")

If fileName = "False" Then
End
End If

On Error GoTo eh
Const adTypeText = 2
Const adSaveCreateOverWrite = 2

Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Charset = "UTF-8"
BinaryStream.Type = adTypeText
BinaryStream.Open

                                    '   calculate the last column number
MaxCol = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
S = Chr(34)                         '   double quote

For Each Cell In ActiveSheet.UsedRange ' traverse the used range

    S = S & Cell.Value

    If Cell.Column = MaxCol Then    '   last cell in row

        S = S & Chr(34)             '   close the quotes

        BinaryStream.WriteText S, 1

        S = Chr(34)                 '   start next row with quotes

    Else

        S = S + Chr(34) & "," & Chr(34) ' close the quotes, write comma, open quotes

    End If

Next

BinaryStream.SaveToFile fileName, adSaveCreateOverWrite
BinaryStream.Close

MsgBox "CSV generated successfully"

eh:

End Sub

If you need to have cells containing only numbers without quotes, it will need a little more work.

Too bad I cant take both of your answers, I'll take Fratys's as I've harassed him the most with it. Your function works, but gives weird results when i try to manually specify the MaxCol = 3 instead of "ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count" Its probably my fault tough. — helena4, Nov 21 '14 at 15:42

score 0 · Answer 3 · edited May 23 '17 at 12:24

The current solution (which appears in the OP itself) is great except one thing - it adds a BOM. Here's my solution that also strips the BOM (via https://stackoverflow.com/a/4461250/4829915). I've also removed the currently unused label "eh:" from the ending and added nesting:

Sub WriteCSV()
    Set wkb = ActiveSheet
    Dim fileName As String
    Dim MaxCols As Integer
    fileName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")

    If fileName = "False" Then
        End
    End If

    Const adTypeText = 2
    Const adSaveCreateOverWrite = 2
    Const adTypeBinary = 1

    Dim BinaryStream
    Dim BinaryStreamNoBOM
    Set BinaryStream = CreateObject("ADODB.Stream")
    Set BinaryStreamNoBOM = CreateObject("ADODB.Stream")
    BinaryStream.Charset = "UTF-8"
    BinaryStream.Type = adTypeText
    BinaryStream.Open

    For r = 1 To wkb.UsedRange.Rows.Count
        S = ""
        sep = ""

        For c = 1 To wkb.UsedRange.Columns.Count
            S = S + sep
            sep = ","
            If Not IsEmpty(wkb.Cells(r, c).Value) Then
                S = S & """" & wkb.Cells(r, c).Value & """"
            End If
        Next

        BinaryStream.WriteText S, 1
    Next r

    BinaryStream.Position = 3 'skip BOM
    With BinaryStreamNoBOM
        .Type = adTypeBinary
        .Open
        BinaryStream.CopyTo BinaryStreamNoBOM
        .SaveToFile fileName, adSaveCreateOverWrite
        .Close
    End With

    BinaryStream.Close

    MsgBox "CSV generated successfully"

End Sub

Why would you want to skip the BOM? – Thomas Eizinger Apr 18 '16 at 10:06 — Thomas Eizinger, Apr 18 '16 at 10:06

A Working VBA that exports excel to csv UTF8

3 Answers3

Linked