VBA - 用 utf-8 读取 CSV 并用 utf-8 写出另一个 CSV

Question

我正在执行以下步骤，但遇到了 UTF-8 字符问题：
- 读取包含 UTF-8 字符的 CSV 文件（以“|”分隔）。
- 根据特定条件解析文件并保存一个新文件（删除具有相同Remove_ROW文本的行是条件之一）

我保存的文件没有保存 UTF-8 字符。它只是用一些乱码来保存它。

Set tdaywb = Workbooks.Open(lbltoday.Caption) 'lbltoday.Caption has the filename
Set tdaySht = tdaywb.Sheets(1)
tdayLastRow = tdaySht.Range("A" & Rows.Count).End(xlUp).Row

For x = 2 To tdayLastRow
  If x > tdayLastRow Then
       Exit For
  End If
  If InStr(1, tdaySht.Cells(x, 1), "Remove_ROW") > 0 Then
       tdaySht.Rows(x).EntireRow.Delete
       remCount = remCount + 1
       tdayLastRow = tdayLastRow - 1
  End If
Next x

tdaySht.Activate

With ActiveWorkbook
    .SaveAs "C:\test.csv" 
    .Close 0
End With

如果我能在保留 UTF-8 字符的情况下保存它，我将不胜感激。

问候， 阿尤什

Answer 1

经过一番研究，我发现：

Sub OpenTextFile()
strSheetName = ReadUTF8CSVToSheet("C:\file1.csv")
WriteCSV
End Sub

Function ReadUTF8CSVToSheet(file As String)
Dim ws As Worksheet
Dim strText As String
' read utf-8 file to strText variable
   With CreateObject("ADODB.Stream")
    .Open
    .Type = 1  ' Private Const adTypeBinary = 1
    .LoadFromFile file
    .Type = 2  ' Private Const adTypeText = 2
    .Charset = "utf-8"
    strText = .ReadText(-1)  ' Private Const adReadAll = -1
End With

' parse strText data to a sheet
Set ws = Sheets.Add()
intRow = 1
For Each strLine In Split(strText, Chr(10))
    If strLine <> "" Then
        With ws
            .Cells(intRow, 1) = strLine
            .Cells(intRow, 1).TextToColumns Destination:=Cells(intRow, 1), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="|"
        End With

        intRow = intRow + 1
    End If
Next strLine
ReadUTF8CSVToSheet = ws.Name
End Function

Public Sub WriteCSV()
Set wkb = ActiveSheet

Dim fileName As String
Dim MaxCols As Integer
Dim lMaxCol, lMaxRow As Double
fileName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")

If fileName = "False" Then
End
End If

On Error GoTo eh
Const adTypeText = 2
Const adSaveCreateOverWrite = 2

Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Charset = "UTF-8"
BinaryStream.Type = adTypeText
BinaryStream.Open

C = 1
lMaxCol = 0
While Not Len(wkb.Cells(1, C).Value) = 0    'wkb.Cells(row, column).Value
    s = s & wkb.Cells(1, C).Value & "|"
    C = C + 1
Wend
BinaryStream.WriteText s, 1
lMaxCol = C - 1

r = 1
While Not Len(wkb.Cells(r + 1, 1).Value) = 0  'wkb.Cells(row, column).Value
    r = r + 1
Wend
  lMaxRow = r - 1
For r = 1 To lMaxRow
s = ""
For C = 1 To lMaxCol
    s = s & wkb.Cells(r + 1, C).Value & "|"
Next C
BinaryStream.WriteText s, 1
Next r

BinaryStream.SaveToFile fileName, adSaveCreateOverWrite
BinaryStream.Close

MsgBox "CSV generated successfully"

eh:

End Sub