我需要创建一个脚本,在.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
我需要一个对象的信息。那么适当的地方在哪里呢?或者我应该以其他方式做到这一点?
提前谢谢你:)
答案 0 :(得分: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