VBA编码，.csv格式和分隔符的变化

我需要创build一个脚本，使用UTF-8编码并更改分隔符，将活动工作表保存为.csv文件。 我在VBA中是全新的，所以我在这里find了一些有用的代码。 唯一缺less的就是编码。 我试图自己没有成功。

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 

这一个显示我的信息.Charset我需要一个对象。 那么它在哪里呢？ 或者，也许我应该以其他方式做？ 先谢谢你 ：）

Answer 1

这是你的代码根据这个职位

 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