将Excel里所有的Sheet页同时另存为单独的UTF8编码的CSV文件

结合前两篇高手代码，拼出以下代码：

Public Sub WriteCSV()
Dim sheet_name, bookPath, fileName As String
Dim sheet_count,i As Integer
sheet_count = Sheets.Count
bookPath = ThisWorkbook.Path
   bookPath = bookPath + "\TEMP\"
    '判断文件目录是否存在
   If Dir(bookPath, 16) = Empty Then
    MkDir bookPath
   Else
    Kill bookPath & "\*.*"
   End If
For i = 1 To sheet_count

    sheet_name = Sheets(i).Name
    Sheets(sheet_name).Select
	'设置活动窗口为当前
	Set wkb = ActiveSheet
    fileName = bookPath + sheet_name + ".csv"

    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

    For r = 1 To wkb.UsedRange.Rows.Count
    s = ""
    c = 1
	While c <= wkb.UsedRange.Columns.Count
	If c < wkb.UsedRange.Columns.Count Then
     s = s & wkb.Cells(r, c).Value & ","
	Else
	 s = s & wkb.Cells(r, c).Value
	End if
    c = c + 1
    Wend
    BinaryStream.WriteText s, 1
    Next r

    BinaryStream.SaveToFile fileName, adSaveCreateOverWrite
    BinaryStream.Close
eh:
Next
Sheets(1).Select
MsgBox "CSV generated successfully"
End Sub

完美运行