VBA - encoding, .csv format and separators' change

Question

I need to create a script which saves active sheet in .csv, using UTF-8 encoding and changes separators. I'm totally new in VBA thing so I've found here some useful code. The one thing that is missing is encoding. I tried to do it by myself without success.

Sub Zapisz_Arkusz_Jako_CSV()

'wg http://www.mcgimpsey.com/excel/textfiles.html

Const myListSeparator As String = ";"
Const myDecimalSeparator As String = "."
Const myDateFormat As String = "yyyy-mm-dd"

Dim Path As String
Dim nFileNum As Long
Dim myRecord As Range
Dim myField As Range
Dim myFieldText As String
Dim sOut As String

Path = Left(ActiveWorkbook.FullName, _
          InStr(ActiveWorkbook.FullName, ".") - 1) & _
          "_" & ActiveSheet.Name & ".csv"


If MsgBox("Arkusz zostanie zapisany jako:  " & _
        vbNewLine & vbNewLine & Path, vbOKCancel, _
        "  Zapisywanie aktywnego arkusza") = vbOK Then

nFileNum = FreeFile
Open Path For Output As #nFileNum

For Each myRecord In Range("A1:A" & _
                           Range("A" & Rows.Count).End(xlUp).Row)
  With myRecord
    For Each myField In Range(.Cells, _
                              Cells(.Row, Columns.Count).End(xlToLeft))
      Select Case TypeName(myField.Value)
      Case "Date"
        myFieldText = Format(myField.Value, myDateFormat)
      Case "Double", "Currency"
        myFieldText = WorksheetFunction.Substitute( _
                      myField.Text, _
                      Application.DecimalSeparator, _
                      myDecimalSeparator)
      Case Else
        myFieldText = myField.Text
      End Select
      sOut = sOut & myListSeparator & myFieldText
    Next myField
    Print #nFileNum, Mid(sOut, 2)
    sOut = Empty
  End With
  Output.Charset = "utf-8"
Next myRecord
Close #nFileNum
 End If
End Sub

This one shows me information that for .Charset i need an object. So where is the proper place for it? Or maybe should I do it other way? Thank you in advance :)

Have you tried looking at this http://stackoverflow.com/questions/2524703/save-text-file-utf-8-encoded-with-vba. Should contain the information you need. — Mister 832, Aug 12 '16 at 10:03
@Mister832 yes, I've tried. But my problem is that in that code above there is no such thing like `Dim fsT As Object Set fsT = CreateObject("ADODB.Stream")` and I don't know which variable should I here set as an object. — lawstud, Aug 12 '16 at 10:13

score 1 · Accepted Answer · edited May 23 '17 at 11:51

Here is your code according to this post

Sub Zapisz_Arkusz_Jako_CSV()


'wg http://www.mcgimpsey.com/excel/textfiles.html


Const myListSeparator As String = ";"
Const myDecimalSeparator As String = "."
Const myDateFormat As String = "yyyy-mm-dd"

Dim Path As String
Dim nFileNum As Long
Dim myRecord As Range
Dim myField As Range
Dim myFieldText As String
Dim sOut As String

Path = Left(ActiveWorkbook.FullName, _
      InStr(ActiveWorkbook.FullName, ".") - 1) & _
      "_" & ActiveSheet.Name & ".csv"

If MsgBox("Arkusz zostanie zapisany jako:  " & _
    vbNewLine & vbNewLine & Path, vbOKCancel, _
    "  Zapisywanie aktywnego arkusza") = vbOK Then

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

For Each myRecord In Range("A1:A" & _
                       Range("A" & Rows.Count).End(xlUp).Row)
    With myRecord
        For Each myField In Range(.Cells, _
                          Cells(.Row, Columns.Count).End(xlToLeft))
          Select Case TypeName(myField.Value)
             Case "Date"
                myFieldText = Format(myField.Value, myDateFormat)
              Case "Double", "Currency"
                myFieldText = WorksheetFunction.Substitute( _
                  myField.Text, _
                  Application.DecimalSeparator, _
                  myDecimalSeparator)
              Case Else
                myFieldText = myField.Text
          End Select
          sOut = sOut & myListSeparator & myFieldText
        Next myField
        fsT.WriteText Mid(sOut, 2) & vbCrLf
        sOut = Empty
    End With

    Next myRecord
    fsT.SaveToFile Path, 2 'Save binary data To disk
    fsT.Flush
    fsT.Close
    End If
End Sub

Oh God. Thank you very very much :) – lawstud Aug 12 '16 at 10:16 — lawstud, Aug 12 '16 at 10:16

VBA - encoding, .csv format and separators' change

1 Answers1