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字符保存此功能的帮助。

此致 AYUSH

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

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

1 个答案: