使用UTF-8编码将工作簿另存为CSV

时间:2016-11-21 04:22:52

标签: excel vba excel-vba csv

如何在不丢失UTF-8字符的情况下将工作簿保存为CSV?

到目前为止,这是我将工作簿保存为CSV的代码:

Option Explicit
Public wb As Workbook, ws As Worksheet, venture As String, intl As String, SvPath As String

Private Function chopFilesThenSave()
  Dim NumOfColumns As Long
  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?
  Dim p As Long

  'Initialize data
  Set ws = ThisWorkbook.Sheets("MixedNuts")
  NumOfColumns = ws.UsedRange.Columns.Count
  WorkbookCounter = 1
  RowsInFile = 2000 + 1 'how many rows (incl. header in new files?

  'Check if the folder provided is exist, else create one!
    If Len(Dir(SvPath & "batch\", vbDirectory)) = 0 Then
       MkDir SvPath & "batch\"
    End If

  'Copy the data of the first row (header)
  Set RangeOfHeader = ws.Range(ws.Cells(1, 1), ws.Cells(1, NumOfColumns))

  For p = 2 To ThisWorkbook.Sheets("Mixed").UsedRange.Rows.Count Step RowsInFile - 1
    Set wb = Workbooks.Add

    'Paste the header row in new file
    RangeOfHeader.Copy wb.Sheets(1).Range("A1")

    wb.Sheets(1).Range("A:B").NumberFormat = "@" 'set column as text

    'Paste the chunk of rows for this file
    Set RangeToCopy = ws.Range(ws.Cells(p, 1), ws.Cells(p + RowsInFile - 2, NumOfColumns))
    RangeToCopy.Copy
    wb.Sheets(1).Range("A2").PasteSpecial xlPasteValues

    'Save the new workbook, and close it
    wb.SaveAs SvPath & "batch\" & venture & intl & "BatchUpdate_" & Format(Now, "mmDDYYYY") & "-" & WorkbookCounter & ".csv", xlCSV
    wb.Close False

    'Increment file counter
    WorkbookCounter = WorkbookCounter + 1
  Next p

  Set wb = Nothing
End Function

代码在循环中运行,我从工作表" MixedNuts"中剪切2,000行(不包括标题),复制并粘贴到新工作簿,然后将其另存为CSV并在下一行再次执行此操作。但同样,问题是在将其保存为CSV后,utf-8字符成为问号。

0 个答案:

没有答案