VBA Create Text file in UTF-8 rather then ANSI

BalloutMoe

Board Regular
Joined
Jun 4, 2021
Messages
137
Office Version
  1. 365
Platform
  1. Windows
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

VBA Code:
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
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
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.

VBA Code:
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!
 
Upvote 0
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.

VBA Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top