Save .txt file in UTF-8 instead of ANSI

D

DemonicWitch

New Member
Joined
Apr 27, 2023
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Hi all,

a friend of mine created a marco that converts the excel entries into a tab delimited .txt file. Unfortunatley since (i guess) an update, it will always save as ANSI, which causes some e.g. kyrillic symbols to be displayed as ? instead of the actual symbols shown in the excel file.

Here is the code:

VBA Code: 
Private Sub CommandButton1_Click()

    Dim letzteZeilenNummer As Long
    Dim zeilenNummer        As Long
    Dim dateiSpeicherOrt    As String
    Dim materialNummer      As String
    Dim sprache             As String
    Dim nummer              As String
    Dim text                As String
    Dim textObjekt          As String
    Dim textID              As String
    Dim output              As String
    Dim strformat           As String
    
    
    'Range("A23").Value = ChrW(&HAC1A)
    
    
    'Ermittlung der letzten belegten Zeile
    letzteZeilenNummer = Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row
    
    output = dateiNameOhneEndung(ThisWorkbook.Name)
    
    
    'Festlegung des Speicherortes und der Dateibenennung
    dateiSpeicherOrt = ThisWorkbook.Path & "\" & output & ".txt"
    
    Open dateiSpeicherOrt For Output As #99
    For zeilenNummer = 1 To letzteZeilenNummer
    
        'Auslesen der Materialnummer und der Spalten 2 und 3 aus der jeweiligen Zeile
        If zeilenNummer > 1 Then
            materialNummer = format(Tabelle1.Cells(zeilenNummer, 1).Value, "000000000000000000")
            sprache = SpracheZuIndex(Tabelle1.Cells(zeilenNummer, 2).Value)
            nummer = "1"
            text = Tabelle1.Cells(zeilenNummer, 3).Value
            textObjekt = "MATERIAL"
            textID = "PRUE"
            strformat = "*"
            
            
            Const maximaleZeichenAnzahl As Integer = 134
            Dim benoetigteOutputZeilen As Integer
            Dim restZeichenLetzteZeile As Integer
            Dim i                       As Integer
            Dim position                 As Integer
            
            benoetigteOutputZeilen = Len(text) \ maximaleZeichenAnzahl
            restZeichenLetzteZeile = Len(text) Mod maximaleZeichenAnzahl
            
            position = 1
            'Schleife für die Befüllung von vollen Zeilen mit 134 Zeichen
            For i = 1 To benoetigteOutputZeilen
                Print #99, textObjekt & vbTab & textID & vbTab & sprache & vbTab & materialNummer & vbTab & i & vbTab & strformat & vbTab & Mid(text, position, maximaleZeichenAnzahl)
                'für jeden Schleifendurchlauf Position erhöht und abholung der nächsten 134 Zeichen
                position = position + maximaleZeichenAnzahl
            Next i
            
            'letzte Zeile mit dem Rest ausgeben
            'oder
            'die Zeile auszugeben, die kürzer als 134 Zeichen ist
            If restZeichenLetzteZeile > 0 Then
                Print #99, textObjekt & vbTab & textID & vbTab & sprache & vbTab & materialNummer & vbTab & i & vbTab & strformat & vbTab & Mid(text, position)
            End If
            
        Else
            'Übertragung der Überschriften ohne Formatierung
            materialNummer = Tabelle1.Cells(zeilenNummer, 1).Value
            sprache = Tabelle1.Cells(zeilenNummer, 2).Value
            nummer = "No"
            text = Tabelle1.Cells(zeilenNummer, 3).Value
            textObjekt = "Textobjekt"
            textID = "TextID"
            strformat = "Format"
            
            Print #99, textObjekt & vbTab & textID & vbTab & sprache & vbTab & materialNummer & vbTab & nummer & vbTab & strformat & vbTab & text
        End If
        
    Next zeilenNummer
    Close #99
    
End Sub


Private Function dateiNameOhneEndung(dateiNamen As String) As String

    dateiNameOhneEndung = Left(dateiNamen, Len(dateiNamen) - 5)
    
End Function

Private Function SpracheZuIndex(sprache As String) As String

    Dim sprachIndex As String

    
    'trim löscht alle Leerzeichen
    Select Case Trim(sprache)
        Case "Serbian"
            sprachIndex = "0"
        Case "Chinese"
            sprachIndex = "1"
        Case "Thai"
            sprachIndex = "2"
        Case "Korean"
            sprachIndex = "3"
        Case "Romanian"
            sprachIndex = "4"
        Case "Slovenian"
            sprachIndex = "5"
        Case "Croatian"
            sprachIndex = "6"
        Case "Malaysian"
            sprachIndex = "7"
        Case "Ukrainian"
            sprachIndex = "8"
        Case "Estonian"
            sprachIndex = "9"
        Case "Arabic"
            sprachIndex = "A"
        Case "Hebrew"
            sprachIndex = "B"
        Case "Czech"
            sprachIndex = "C"
        Case "German"
            sprachIndex = "D"
        Case "English"
            sprachIndex = "E"
        Case "French"
            sprachIndex = "F"
        Case "Greek"
            sprachIndex = "G"
        Case "Hungarian"
            sprachIndex = "H"
        Case "Italian"
            sprachIndex = "I"
        Case "Japanese"
            sprachIndex = "J"
        Case "Danish"
            sprachIndex = "K"
        Case "Polish"
            sprachIndex = "L"
        Case "Chinese trad."
            sprachIndex = "M"
        Case "Dutch"
            sprachIndex = "N"
        Case "Norwegian"
            sprachIndex = "O"
        Case "Portuguese"
            sprachIndex = "P"
        Case "Slovakian"
            sprachIndex = "Q"
        Case "Russian"
            sprachIndex = "R"
        Case "Spanish"
            sprachIndex = "S"
        Case "Turkish"
            sprachIndex = "T"
        Case "Finnish"
            sprachIndex = "U"
        Case "Swedish"
            sprachIndex = "V"
        Case "Bulgarian"
            sprachIndex = "W"
        Case "Lithuanian"
            sprachIndex = "X"
        Case "Latvian"
            sprachIndex = "Y"
        Case "Customer reserve"
            sprachIndex = "Z"
        Case "Afrikaans"
            sprachIndex = "a"
        Case "Icelandic"
            sprachIndex = "b"
        Case "Catalan"
            sprachIndex = "c"
        Case "Serbian (Latin)"
            sprachIndex = "d"
        Case "Indonesian"
            sprachIndex = "i"
        Case "Vietnamese"
            sprachIndex = "fill in manually"
        Case Else
            sprachIndex = "unbekannt"
    End Select
    
    SpracheZuIndex = sprachIndex
    
End Function

Could you please point me to where I need to enter the settings and how? I did some research but it seems like the file creation works differently here.
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Sort by date Sort by votes
Put:
VBA Code: 
Set oStreamUTF8NoBOM = CreateObject("ADODB.Stream")
        With oStreamUTF8NoBOM
            .Charset = "UTF-8"
            .Type = 2
            .Open
        End With
somewhere at start of macro.
And then when you are using
VBA Code: 
Print #99, XXXXXXXXXX
use instead code below:
VBA Code: 
        With oStreamUTF8NoBOM
          .WriteText XXXXXXXXXXXX
        End With
and finally at the end of macro:

VBA Code: 
        With oStreamUTF8NoBOM
            .SaveToFile dateiSpeicherOrt, 2
        End With
        oStreamUTF8NoBOM.Close
 
Upvote 1
Solution
KOKOSEK said:
Put:
VBA Code: 
Set oStreamUTF8NoBOM = CreateObject("ADODB.Stream")
        With oStreamUTF8NoBOM
            .Charset = "UTF-8"
            .Type = 2
            .Open
        End With
somewhere at start of macro.
And then when you are using
VBA Code: 
Print #99, XXXXXXXXXX
use instead code below:
VBA Code: 
        With oStreamUTF8NoBOM
          .WriteText XXXXXXXXXXXX
        End With
and finally at the end of macro:

VBA Code: 
        With oStreamUTF8NoBOM
            .SaveToFile dateiSpeicherOrt, 2
        End With
        oStreamUTF8NoBOM.Close
Click to expand...
That help, but it seems like oStreamUTF8NoBOM is not happy with beeing undefined. Could it be that I am missing a library or something similar?
1682596295141.png
 
Upvote 0
Did you check posts from thread which I am referencing?
Add in declaration section:

VBA Code: 
Dim oStreamUTF8NoBOM As Object
 
Upvote 1
Blind me, sorry for that.
It worked nearly perfectly, but it seems like "Enter" is not done, or new lines are not used but it is all in one line.
Current State of the code
VBA Code: 
Private Sub CommandButton1_Click()

    Dim letzteZeilenNummer As Long
    Dim zeilenNummer        As Long
    Dim dateiSpeicherOrt    As String
    Dim materialNummer      As String
    Dim sprache             As String
    Dim nummer              As String
    Dim text                As String
    Dim textObjekt          As String
    Dim textID              As String
    Dim output              As String
    Dim strformat           As String
    Dim oStreamUTF8NoBOM As Object
    
    
    
    
    Set oStreamUTF8NoBOM = CreateObject("ADODB.Stream")
    
        With oStreamUTF8NoBOM
            .Charset = "UTF-8"
            .Type = 2
            .Open
        End With
    
    'Ermittlung der letzten belegten Zeile
    letzteZeilenNummer = Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row
    
    output = dateiNameOhneEndung(ThisWorkbook.Name)
    
    
    'Festlegung des Speicherortes und der Dateibenennung
    dateiSpeicherOrt = ThisWorkbook.Path & "\" & output & ".txt"
    
    Open dateiSpeicherOrt For Output As #99
    For zeilenNummer = 1 To letzteZeilenNummer
    
        'Auslesen der Materialnummer und der Spalten 2 und 3 aus der jeweiligen Zeile
        If zeilenNummer > 1 Then
            materialNummer = format(Tabelle1.Cells(zeilenNummer, 1).Value, "000000000000000000")
            sprache = SpracheZuIndex(Tabelle1.Cells(zeilenNummer, 2).Value)
            nummer = "1"
            text = Tabelle1.Cells(zeilenNummer, 3).Value
            textObjekt = "MATERIAL"
            textID = "PRUE"
            strformat = "*"
            
            
            Const maximaleZeichenAnzahl As Integer = 134
            Dim benoetigteOutputZeilen As Integer
            Dim restZeichenLetzteZeile As Integer
            Dim i                       As Integer
            Dim position                 As Integer
            
            benoetigteOutputZeilen = Len(text) \ maximaleZeichenAnzahl
            restZeichenLetzteZeile = Len(text) Mod maximaleZeichenAnzahl
            
            position = 1
            'Schleife für die Befüllung von vollen Zeilen mit 134 Zeichen
            For i = 1 To benoetigteOutputZeilen
                With oStreamUTF8NoBOM
                    .WriteText textObjekt & vbTab & textID & vbTab & sprache & vbTab & materialNummer & vbTab & i & vbTab & strformat & vbTab & Mid(text, position, maximaleZeichenAnzahl)
                End With
                'Print #99, textObjekt & vbTab & textID & vbTab & sprache & vbTab & materialNummer & vbTab & i & vbTab & strformat & vbTab & Mid(text, position, maximaleZeichenAnzahl)
                'für jeden Schleifendurchlauf Position erhöht und abholung der nächsten 134 Zeichen
                position = position + maximaleZeichenAnzahl
            Next i
            
            'letzte Zeile mit dem Rest ausgeben
            'oder
            'die Zeile auszugeben, die kürzer als 134 Zeichen ist
            If restZeichenLetzteZeile > 0 Then
                With oStreamUTF8NoBOM
                    .WriteText textObjekt & vbTab & textID & vbTab & sprache & vbTab & materialNummer & vbTab & i & vbTab & strformat & vbTab & Mid(text, position)
                End With
                
                'Print #99, textObjekt & vbTab & textID & vbTab & sprache & vbTab & materialNummer & vbTab & i & vbTab & strformat & vbTab & Mid(text, position)
            End If
            
        Else
            'Übertragung der Überschriften ohne Formatierung
            materialNummer = Tabelle1.Cells(zeilenNummer, 1).Value
            sprache = Tabelle1.Cells(zeilenNummer, 2).Value
            nummer = "No"
            text = Tabelle1.Cells(zeilenNummer, 3).Value
            textObjekt = "Textobjekt"
            textID = "TextID"
            strformat = "Format"
                With oStreamUTF8NoBOM
                    .WriteText textObjekt & vbTab & textID & vbTab & sprache & vbTab & materialNummer & vbTab & nummer & vbTab & strformat & vbTab & text
                End With
            
            'Print #99, textObjekt & vbTab & textID & vbTab & sprache & vbTab & materialNummer & vbTab & nummer & vbTab & strformat & vbTab & text
        End If
        
    Next zeilenNummer
    Close #99
    
            With oStreamUTF8NoBOM
            .SaveToFile dateiSpeicherOrt, 2
        End With
        oStreamUTF8NoBOM.Close
    
End Sub

Left desired layout, right current layout of the .txt file.
1682598954873.png
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
VBA Code modification to print a range to a .txt file
2
Replies
16
Views
3K
Domenic
D
E
  • Question
Use VBA to loop through all the .txt files in a folder, then transfer the content to an excel sheet
Replies
1
Views
4K
John_w
J
R
  • Question
VBA - Import data from a txt file
Replies
1
Views
681
ravishankar
R
J
  • Question
Save file as .CSV instead of .TXT
Replies
0
Views
251
johnrlalor
J
N
  • Question
VBA Script Save as TXT CSV, UFT-8, set specific field and txt delimeter and Quote all TXT cells??
Replies
0
Views
1K
nhards
N

Forum statistics

Threads
1,214,965
Messages
6,122,500
Members
449,090
Latest member
RandomExceller01

Share this page

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