Export .csv file with UTF-8 encoding in Excel

Question

Hi,

Does anyone know if it is possible to export a .csv file with encoding UTF-8 using Excel 2010? 

I could do it opening my spreadsheet in Microsoft Access or Notepad or even OpenOffice, but not in Microsoft Excel. Since I need to do it many times it would be much easier using just Excel. 

Thanks

Answer 1

Hi,

try this...

Sub ActiveSht_to_CSV_01()

'utf-8

'June 11, 2015

 Const sDelim As String = ";"   '<< select comma or semicolon

 Const sPath As String = "C:\Users\User\Desktop"   '<< export on desktop, change path

 Dim ws As Worksheet

 Set ws = ActiveSheet

 Dim r As Long, c As Long, i As Long, j As Long

 r = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

 c = ws.Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

 Dim sFile As String

 sFile = sPath & "sample.csv" '<< change file name

 Dim obj As Object

 Set obj = CreateObject("ADODB.Stream")

 obj.Type = 2

 obj.Charset = "utf-8"

 obj.Open

 Dim v() As Variant

 ReDim v(1 To c)

 For i = 1 To r

 For j = 1 To c

 v(j) = ws.Cells(i, j).Text  'or Value

 Next

 obj.WriteText Join(v, sDelim), 1

 Next

 obj.SaveToFile sFile, 2

 MsgBox "done"

 End Sub

xxxxxxxxxxxxxxxxxxx

and

(encoding ANSI)

Sub ActiveSht_to_CSV_02()

'ANSI

'June 11, 2015

Const sFile As String = "C:\Users\User\Desktop\sample.csv"   '<< export on desktop, change path/name

Dim ws As Worksheet

Set ws = ActiveSheet

Application.ScreenUpdating = False

Application.DisplayAlerts = False

ws.Copy

ActiveWorkbook.SaveAs sFile, FileFormat:=xlCSV, local:=True

ActiveWorkbook.Close False

Application.DisplayAlerts = True

Application.ScreenUpdating = True

MsgBox "done"

End Sub

Answer 2

Hi,

The following code writes a csv in udf-8 and with linefeed as lin separator.

Copying this code will not work directly because of reference you will not find here.

You can download the full ad-in here JP's Extension

Sub WriteCSVFileNew(strSeparator, ByVal strTextQLF, blnSuppress)   ''' should ask for separator & textqualifier

   Dim lngFirstRow      As Long, strFirstColumn As String

   Dim lngLastRow       As Long, strLastColumn As String

   Dim strEvaluate      As String

   Dim lngCount         As Long

   Dim fs               As New Scripting.FileSystemObject

   Dim adoText          As New ADODB.Stream

   Dim adoBin           As New ADODB.Stream

   Dim varFile          As Variant

   Dim varYesNo         As Variant

   varFile = Application.GetSaveAsFilename(, "CSV Files (*.csv),*.csv", , JPE_APP_TITLE)

   If varFile = False Then Exit Sub

   If fs.FileExists(CStr(varFile)) Then

      varYesNo = MsgBox(Prompt:=Mid(varFile, InStrRev(varFile, "") + 1) & " already exists, do you want to overwrite?", Buttons:=vbYesNo, Title:=JPE_APP_TITLE)

      If varYesNo = vbNo Then Exit Sub

   End If

   Select Case strTextQLF

      Case "Double": strTextQLF = Chr(34)

      Case "Single": strTextQLF = Chr(39)

      Case "None": strTextQLF = vbNullString

   End Select

   With ActiveSheet.Range(ActualUsedRange())

      lngFirstRow = Replace(Split(.Address, "$")(2), ":", "")

      lngLastRow = Split(.Address, "$")(4)

      strFirstColumn = Split(.Address, "$")(1)

      strLastColumn = Split(.Address, "$")(3)

   End With

   InitProgressBar

   ''' set the way to write

   With adoText

      .Open

      .Type = adTypeText

      .Charset = "utf-8"

      .LineSeparator = adLF

   End With

   For lngCount = lngFirstRow To lngLastRow

      If gbln_jpeSaveFiltered Then

         If Not Rows(lngCount).Hidden Then

            strEvaluate = RangeConcat(Range(strFirstColumn & lngCount & ":" & strLastColumn & lngCount), strSeparator, strTextQLF, blnSuppress)

            adoText.WriteText strEvaluate, adWriteLine

         End If

      Else

         strEvaluate = RangeConcat(Range(strFirstColumn & lngCount & ":" & strLastColumn & lngCount), strSeparator, strTextQLF, blnSuppress)

         adoText.WriteText strEvaluate, adWriteLine

      End If

      ''' update progress bar

      gdblHandled = gdblHandled + 1

      If gdblToHandle = 0 Then InitProgressBar lngLastRow

      gsngNewTime = Timer

      If (gsngNewTime - gsngStartTimer >= PROG_BAR_INTERVAL) Or (gdblHandled = gdblToHandle) Then ProgressBar gdblHandled, gdblToHandle, gsngNewTime

      ''' end progress bar

   Next lngCount

   With adoBin

      .Type = adTypeBinary

      .Mode = adModeReadWrite

      .Open

   End With

   With adoText

      .Position = 3

      .CopyTo adoBin

      .Flush

      .Close

   End With

   With adoBin

      .SaveToFile varFile, adSaveCreateOverWrite

      .Flush

      .Close

   End With

   Set fs = Nothing

   Set adoText = Nothing

   Set adoBin = Nothing

   ResetProgressBar

End Sub