CODEWITHSUNDEEP
excelvba
leo108
leo108

Reputation: 11

How to save rows to files in UTF-8?

I'm trying to split large txt files into multiple txt files (encoding UTF-8). The language I'm working with is Asian.

I tried some VBA and Python code but I can't make this work. 

Sub ExportTextFiles()

Dim i As Long
Dim LastDataRow As Long
Dim MyFile As String
Dim fnum


    LastDataRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To LastDataRow
        'The next line uses the contents of column A on the same row to name it
        MyFile = "C:\Users\grego\Downloads\" & ActiveSheet.Range("A" & i).Value & ".txt"
        'Use the following line instead to just create a series of numbered files
        'MyFileName = "C:\Users\grego\Downloads\" & i & ".txt"
        fnum = FreeFile()
        Open MyFile For Output As fnum
        Print #fnum, Format(Range("B" & i))
        Close fnum
    Next i

End Sub

This macro works well but the output is ANSI and instead of Unicode I get strings of question marks. Any help would be much appreciated! I could use some python too.

Upvotes: 0

Views: 374

Answers (1)

KekuSemau
KekuSemau

Reputation: 6856

You can use ADO-Stream objects to read and write utf-8 files.

Public Function ReadUTF8(f As String) As String
    Dim st As Object
    Set st = CreateObject("ADODB.Stream")
    st.Charset = "utf-8"
    st.Open
    st.LoadFromFile f
    ReadUTF8 = st.ReadText
    st.Close
    Set st = Nothing
End Function

Public Sub WriteUTF8(f As String, content As String)
    Const adSaveCreateOverWrite = 2
    Dim st As Object
    Set st = CreateObject("ADODB.Stream")
    st.Charset = "utf-8"
    st.Open
    st.WriteText content
    st.SaveToFile f, adSaveCreateOverWrite
    st.Close
    Set st = Nothing
End Sub

Then you only need this inside the loop:

MyFile = "C:\Users\grego\Downloads\" & ActiveSheet.Range("A" & i).Value & ".txt"
WriteUTF8 MyFile, ActiveSheet.Range("B" & i).Text

Upvotes: 1

Related Questions