VBA Create Text file in UTF-8 rather then ANSI

[BalloutMoe]

Hello all,

I am trying to read a large text file and put some of it in a new text file as a UTF-8 it keeps saving it as ANSI format any help on how to incorporate this in my code? Thank you

Sub GetTextFile()
Const ForReading = 1, ForWriting = 2

Dim fso, FileIn, FileOut As Object, ArrFileTxt As Variant
Dim OGFileName As String, NewFileName As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set FileIn = fso.OpenTextFile("F:\Abe Files\My Downloads\Codes\UNIRECEIPTS.TXT", ForReading)


ArrFileTxt = Split(FileIn.ReadAll, vbCrLf)

For i = 50000 To UBound(ArrFileTxt)
If InStr(ArrFileTxt(i), "/2022") Then
    Debug.Print "True"
    i = i - 15
    j = i
    FileIn.Close
    'Kill ("F:\Abe Files\My Downloads\Codes\BONHAMRECEIPTS - Copy.TXT")
    Set FileOut = fso.CreateTextFile("F:\Abe Files\My Downloads\Codes\UNIRECEIPTSNEW.TXT")
    GoTo WriteToFile
    
End If
Next

WriteToFile:
For t = j To UBound(ArrFileTxt)
  FileOut.WriteLine Trim(ArrFileTxt(t)) & vbCrLf
Next


Set ArrFileTxt = Nothing

FileOut.Close

End Sub

 

[BalloutMoe]

UTF-8noBOM

 

[Domenic]

You can use the Stream object from the ADODB library to create a text file in UTF-8 without a BOM. I have amended your code accordingly. By the way, you'll notice that I've replace your GoTo statement with Exit For to accomplish the same thing.

Option Explicit

Sub test()

    Dim oStreamUTF8 As Object
    Dim oStreamUTF8NoBOM As Object
    Dim data As String
    Dim ArrFileTxt() As String
    Dim i As Long
    Dim j As Long
    Dim t As Long
    Dim found As Boolean
    
    Set oStreamUTF8 = CreateObject("ADODB.Stream")
    
    With oStreamUTF8
        .Charset = "UTF-8"
        .Type = 2 'adTypeText
        .Open
        .LoadFromFile "F:\Abe Files\My Downloads\Codes\UNIRECEIPTS.TXT"
        data = .ReadText
        .Close
    End With
    
    ArrFileTxt = Split(data, vbCrLf)
    
    found = False
    For i = 50000 To UBound(ArrFileTxt)
        If InStr(ArrFileTxt(i), "/2022") Then
            Debug.Print "True"
            i = i - 15
            j = i
            found = True
            Exit For
        End If
    Next
    
    If found Then
        With oStreamUTF8
            .Charset = "UTF-8"
            .Type = 2 'adTypeText
            .Open
            For t = j To UBound(ArrFileTxt)
              .WriteText Trim(ArrFileTxt(t)) & vbCrLf
            Next
            .Position = 3 'skip byte order mark
        End With
        Set oStreamUTF8NoBOM = CreateObject("ADODB.Stream")
        With oStreamUTF8NoBOM
            .Type = 1 'adTypeBinary
            .Open
            oStreamUTF8.CopyTo oStreamUTF8NoBOM
            .SaveToFile "F:\Abe Files\My Downloads\Codes\UNIRECEIPTSNEW.TXT", 2 'adSaveCreateOverWrite
        End With
        oStreamUTF8.Close
        oStreamUTF8NoBOM.Close
    End If
    
End Sub

Hope this helps!

 

[BalloutMoe]

You can use the Stream object from the ADODB library to create a text file in UTF-8 without a BOM. I have amended your code accordingly. By the way, you'll notice that I've replace your GoTo statement with Exit For to accomplish the same thing.

Option Explicit

Sub test()

    Dim oStreamUTF8 As Object
    Dim oStreamUTF8NoBOM As Object
    Dim data As String
    Dim ArrFileTxt() As String
    Dim i As Long
    Dim j As Long
    Dim t As Long
    Dim found As Boolean
   
    Set oStreamUTF8 = CreateObject("ADODB.Stream")
   
    With oStreamUTF8
        .Charset = "UTF-8"
        .Type = 2 'adTypeText
        .Open
        .LoadFromFile "F:\Abe Files\My Downloads\Codes\UNIRECEIPTS.TXT"
        data = .ReadText
        .Close
    End With
   
    ArrFileTxt = Split(data, vbCrLf)
   
    found = False
    For i = 50000 To UBound(ArrFileTxt)
        If InStr(ArrFileTxt(i), "/2022") Then
            Debug.Print "True"
            i = i - 15
            j = i
            found = True
            Exit For
        End If
    Next
   
    If found Then
        With oStreamUTF8
            .Charset = "UTF-8"
            .Type = 2 'adTypeText
            .Open
            For t = j To UBound(ArrFileTxt)
              .WriteText Trim(ArrFileTxt(t)) & vbCrLf
            Next
            .Position = 3 'skip byte order mark
        End With
        Set oStreamUTF8NoBOM = CreateObject("ADODB.Stream")
        With oStreamUTF8NoBOM
            .Type = 1 'adTypeBinary
            .Open
            oStreamUTF8.CopyTo oStreamUTF8NoBOM
            .SaveToFile "F:\Abe Files\My Downloads\Codes\UNIRECEIPTSNEW.TXT", 2 'adSaveCreateOverWrite
        End With
        oStreamUTF8.Close
        oStreamUTF8NoBOM.Close
    End If
   
End Sub

Hope this helps!

Thank you I will give it a go. I appreciate it