Question

我需要创建一个脚本，在.csv中保存活动工作表，使用UTF-8编码并更改分隔符。我在VBA中是一个全新的东西，所以我发现了here一些有用的代码。缺少的一件事就是编码。我试图自己做但没有成功。

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

以下是根据此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

VBA - 编码，.csv格式和分隔符＆＃39;更改

1 个答案: