VBA - encoding, .csv format and separators' change - excel

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 :)

Answer 1

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