将电子表格/ excel文件分割为多个采用UTF-8编码的csv文件

下面的代码成功地将大的Excel文件转换为具有指定行数的csv文件。 我怎么想输出文件是UTF-8编码的CSV文件。

如何将UTF-8代码添加到下面，我想将下面的拆分文件代码与UTF-8转换代码结合起来

Sub test() Dim wb As Workbook Dim ThisSheet As Worksheet Dim NumOfColumns As Integer Dim RangeToCopy As Range Dim RangeOfHeader As Range 'data (range) of header row Dim WorkbookCounter As Integer Dim RowsInFile 'how many rows (incl. header) in new files? Application.ScreenUpdating = False 'Initialize data Set ThisSheet = ThisWorkbook.ActiveSheet NumOfColumns = ThisSheet.UsedRange.Columns.Count WorkbookCounter = 1 RowsInFile = 5 'as your example, just 10 rows per file 'Copy the data of the first row (header) Set RangeOfHeader = ThisSheet.Range(ThisSheet.Cells(1, 1), ThisSheet.Cells(1, NumOfColumns)) For p = 2 To ThisSheet.UsedRange.Rows.Count Step RowsInFile - 1 Set wb = Workbooks.Add 'Paste the header row in new file RangeOfHeader.Copy wb.Sheets(1).Range("A1") 'Paste the chunk of rows for this file Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p + RowsInFile - 2, NumOfColumns)) RangeToCopy.Copy wb.Sheets(1).Range("A2") 'Save the new workbook, and close it wb.SaveAs ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & "_v" & WorkbookCounter & ".csv", FileFormat:=xlCSV wb.Close True 'Increment file counter WorkbookCounter = WorkbookCounter + 1 Next p Application.ScreenUpdating = True Set wb = Nothing End Sub 

Answer 1

您可以使用ADODB库Stream对象。 下面的代码使用早期的绑定，所以不要忘记在运行之前相应地勾选相关的MS ActiveX数据对象参考。

 Sub saveAsUTF8() Dim myStream As ADODB.Stream Dim ws As Worksheet Dim curRow As String Dim curRowRng As Range Dim curCell As Range Set myStream = New ADODB.Stream Set ws = ThisWorkbook.ActiveSheet With myStream .Type = adTypeText .Charset = "UTF-8" .Open For Each curRowRng In ws.UsedRange.Rows curRow = "" For Each curCell In curRowRng.Cells curRow = curRow & "," & curCell.Value Next curCell curRow = Right(curRow, Len(curRow) - 1) .WriteText curRow, adWriteLine Next curRowRng 'CHANGE TO YOU DESTINATION DIRECTORY .SaveToFile "YOUR_PATH\utf8file.csv", adSaveCreateOverWrite .Close End With End Sub