Public Sub WriteCSV() Set wkb = ActiveSheet Dim fileName As String Dim MaxCols As Integer fileName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")
Dim BinaryStream Set BinaryStream = CreateObject("ADODB.Stream") BinaryStream.Charset = "UTF-8" BinaryStream.Type = adTypeText BinaryStream.Open
For r = 1 To 10 s = "" c = 1 While Not IsEmpty(wkb.Cells(r, c).Value) s = s & wkb.Cells(r, c).Value & "," c = c + 1 Wend BinaryStream.WriteText s, 1 Next r
엑셀 파일 내용을 CSV파일로 UTF-8로 인코딩해서 export하는 소스가 있습니다.
http://slway000.tistory.com/17
https://techspread.wordpress.com/2012/12/05/export-excel-to-csv-in-unicode-utf-8-using-macro-vba/
참고하시기 바랍니다.
Public Sub WriteCSV()
Set wkb = ActiveSheet
Dim fileName As String
Dim MaxCols As Integer
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
For r = 1 To 10
s = ""
c = 1
While Not IsEmpty(wkb.Cells(r, c).Value)
s = s & wkb.Cells(r, c).Value & ","
c = c + 1
Wend
BinaryStream.WriteText s, 1
Next r
BinaryStream.SaveToFile fileName, adSaveCreateOverWrite
BinaryStream.Close
MsgBox "CSV generated successfully"
eh:
End Sub