output UTF-8 text files in excel vba-CodePudding

I want to output the Japanese written on the sheet as a UTF-8 text file. The current code also works, but this code export SJIS file. Is the problem that I am getting it in range and outputting it? Or is there something wrong with the SaveAs Filename code?

Set rng = Range("A1").CurrentRegion

Workbooks.Add
ActiveSheet.Cells.Select
Selection.NumberFormatLocal = "@"
rng.Copy ActiveSheet.Range("A1")

Rows(1).Delete

ActiveWorkbook.SaveAs Filename:=fPath & fName, FileFormat:=xlText, Local:=True
ActiveWindow.Close

Worksheets("sheetname").Select
    
Application.DisplayAlerts = True

CodePudding user response：

Please, try the next code. It will not use Excel `SaveAs. It will build a string from the existing cells and save it in a different way:

Sub testExportUth8_NoBOM()
    Dim sh As Worksheet, strTxt As String, strLine As String
    Dim strName As String, arr, i As Long, j As Long, sep As String
    
    Set sh = ActiveSheet
    arr = sh.UsedRange.Value
    sep = "," 'you can use here any needed separator
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            strLine = strLine & arr(i, j) & sep
        Next j
        strLine = left(strLine, Len(strLine) - 1)
        strTxt = strTxt & strLine & vbCrLf
        strLine = ""
    Next i
    strName = ThisWorkbook.path & "\testUTF8_No_BOOM.txt" 'use here the name you want
    WriteUTF8WithoutBOM strTxt, strName
End Sub

Private Function WriteUTF8WithoutBOM(strText As String, fileName As String)
  Dim UTFStream As Object, BinaryStream As Object
  With CreateObject("adodb.stream")
     .Type = 2: .Mode = 3: .Charset = "UTF-8"
     .LineSeparator = -1
     .Open: .WriteText strText, 1
     .Position = 3 'skip BOM' !!!
     Set BinaryStream = CreateObject("adodb.stream")
         BinaryStream.Type = 1
         BinaryStream.Mode = 3
         BinaryStream.Open
        .CopyTo BinaryStream
        .Flush
    .Close
  End With
    BinaryStream.SaveToFile fileName, 2
    BinaryStream.Flush
    BinaryStream.Close
End Function

Please run it and send some feedback.