I have to convert excel rows into individual text files and the text files should be UTF-8 encoded

Question

I am using this code to convert rows to individual text files.

Sub SaveWorksheet()
Dim MyWorkbook As Workbook
Dim MyDataWorksheet As Worksheet

Set MyWorkbook = Workbooks(ActiveWorkbook.Name)
Set MyDataWorksheet = MyWorkbook.Sheets("Data")

Dim OutputFile As String
Dim CellValue As String
Dim CurrentRow As Long
Dim CurrentCol As Long
Dim CurrentCharacter As Long
Dim LastRow As Long
Dim MyString As String

LastRow = MyDataWorksheet.Cells(Rows.Count, "a").End(xlUp).Row

For CurrentRow = 2 To LastRow

OutputFile = "C:\Users\PARSAH\Music\ClobFiles" & CurrentRow & ".txt"

Open OutputFile For Output As #1


    CellValue = MyDataWorksheet.Cells(CurrentRow, 7).Value
    'Write #1, CellValue
    Print #1, CellValue

Close #1

Next CurrentRow

MsgBox "Done"

End Sub

Can anyone help me to convert it into UTF-8 because I have 65531 files created I can't do it manually.

Answer 1

Give this a shot.

Sub SaveWorksheet()
    Dim MyWorkbook As Workbook
    Dim MyDataWorksheet As Worksheet

    Set MyWorkbook = Workbooks(ActiveWorkbook.Name)
    Set MyDataWorksheet = MyWorkbook.Sheets("Data")

    Dim OutputFile As String
    Dim CellValue As String
    Dim CurrentRow As Long
    Dim CurrentCol As Long
    Dim CurrentCharacter As Long
    Dim LastRow As Long
    Dim MyString As String
    Dim fso, f

    LastRow = MyDataWorksheet.Cells(Rows.Count, "a").End(xlUp).Row

    For CurrentRow = 2 To LastRow

        OutputFile = "C:\Users\PARSAH\Music\ClobFiles-" & CurrentRow & ".txt"

        Set fso = CreateObject("Scripting.FileSystemObject")
        Set f = fso.OpenTextFile(OutputFile, 8, True)
        f.WriteLine MyDataWorksheet.Cells(CurrentRow, 7).Value
        f.Close
        
    Next CurrentRow

    MsgBox "Done"

End Sub