Help with .txt files saved as UTI-8, I need to import them into excel with Origin:=65001 (UTF-8)

[Rocko262c]

Dear Everyone,

I have a bunch of .txt files that are saved as UTI-8. When i use the code below to open these documents, the have the incorrect character code.

I would like help either opening these properly with Origin:=65001 (UTF-8) or another method to open the txt file then save as ANSI.

I have written the following code:




Sub ImportFile()


Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String


On Error GoTo ErrHandler
Application.ScreenUpdating = False


sDelimiter = ";"


FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files (*.txt), *.txt", _
MultiSelect:=True, Title:="Text Files to Open")


If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If


x = 1
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
wkbTemp.Sheets(1).Copy
Set wkbAll = ActiveWorkbook
wkbTemp.Close (False)
wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=True, _
Comma:=False, Space:=False, _
Other:=False




Dim lRow As Long
Dim lCol As Long

'Find the last non-blank cell in column A(1)
lRow = Cells(Rows.Count, 1).End(xlUp).Row

'Find the last non-blank cell in row 1
lCol = Cells(1, Columns.Count).End(xlToLeft).Column

Range(Cells(2, 1), Cells(lRow, lCol)).Copy



ExitHandler:
Application.ScreenUpdating = True
Set wkbAll = Nothing
Set wkbTemp = Nothing
Exit Sub


ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub




I have no idea where or how to put Origin:=65001. I have tried many places without success.

Can you kindly help?

Cheers,
Rocko262c

 

[pgc01]

Hi

I posted a while ago how to read a UTF-8 text file.

This is a test you can make to see if it works for you.
It opens the file, reads 10 characters and writes them in A1.

Do this quick test first to see if it works OK with your files.

In the <acronym title="visual basic for applications">vba</acronym> editor set the reference to "Microsoft Active Data Objects 6.1 Library"

Amend the pathname to one of your files.

Sub TestR_utf_8()
Dim st As ADODB.Stream
Dim sPathname As String, sText As String

sPathname = "c:\tmp\test_utf-8.txt"

' create a stream object
Set st = New ADODB.Stream

' set properties
st.Charset = "utf-8"
st.Type = adTypeText

' open the stream object and load the text
st.Open
st.LoadFromFile (sPathname)

' read 10 characters
sText = st.ReadText(10)

' Write the 10 characters in A1 of the current worksheet
Range("A1").Value = sText

st.Close
Set st = Nothing
End Sub

 

[Rocko262c]

Dear Pgc01,

Thanks for your reply and sorry for my late reply.

I have set the reference in my vba editor to "Microsoft Active Data Objects 6.1 Library" and have tried your code. Your code works fine, but it seems that this methodology with ADO and ADODB would just be able to import a string into anywhere you want.

I have read your other reply to the thread "Import text file as UTF-8" as it is the same as mine. Your code works fine, but i am left with data a some long string and am unable to import it into useful rows and columns in a spreadsheet.

Any kind suggestions?

Here is my code again:

Sub ImportSparkasseTxtFile()
'CTRL+D to run this file


    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String


    On Error GoTo ErrHandler
    Application.ScreenUpdating = False


    sDelimiter = ";"


    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Text Files (*.txt), *.txt", _
      MultiSelect:=True, Title:="Text Files to Open")


    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If


 x = 1
    'This works, but the german characters are wrong
    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
    
    'I have tried to replace the line above with all of the following 3 lines, but no success
    'Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen, Delimiter:=Chr(124), Origin:=65001)
    'Workbooks.Open Filename:=FilesToOpen, Delimiter:=Chr(124), Origin:=65001
    'Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x), Delimiter:=Chr(124), Origin:=65001)
    
    wkbTemp.Sheets(1).Copy
    Set wkbAll = ActiveWorkbook




    wkbTemp.Close (False)
    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
      Destination:=Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=False, _
      Tab:=False, Semicolon:=True, _
      Comma:=False, Space:=False, _
      Other:=False




Dim lRow As Long
Dim lCol As Long
    
    'Find the last non-blank cell in column A(1)
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    'Find the last non-blank cell in row 1
    lCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
    Range(Cells(2, 1), Cells(lRow, lCol)).Copy
    


ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
    Set wkbTemp = Nothing
    Exit Sub


ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

Thanks for your kind help,
Rocko262c

 

[Rocko262c]

Oh yeah, the txt file that I am trying to import is delimited like this:

"Buchungstag";"Wertstellung";"Zahlungsgegner";"IBAN";"BIC";"Verwendungszweck";"Betrag";"Währung""01.01.2018";"30.01.2018";"BLAH BLAH";"DE123456789";"ABCDEVGXXX";"2018-01-29T14:41:01 Karte0 2020-12";"-10,00";"EUR"
"01.01.2018";"30.01.2018";"ÄäÖöÜü";"DE123456789";"ABCDEVGXXX";"Transation Message";"-43,50";"EUR"

Cheers,
Rocko262c

 

[Rocko262c]

Sorry, that didn't turn out correct. The text file is delimited like this:

"Buchungstag";"Wertstellung";"Zahlungsgegner";"IBAN";"BIC";"Verwendungszweck";"Betrag";"Währung"
"01.01.2018";"30.01.2018";"BLAH BLAH";"DE123456789";"ABCDEVGXXX";"2018-01-29T14:41:01 Karte0 2020-12";"-10,00";"EUR"
"01.01.2018";"30.01.2018";"ÄäÖöÜü";"DE123456789";"ABCDEVGXXX";"Transation Message";"-43,50";"EUR"

The text is contained in parenthesis and the cells are separated by semicolons.

Cheers,
Rocko262c

 

[Rocko262c]

Dear Everyone,

There was really no help with the above method, but thanks for your help anyways.

I have tried this code and it work just alright.

Sub try03()
    
vbFILEOPEN = "C:\Users\BlahBlah\Desktop\01.txt"

Workbooks.OpenText Filename:=vbFILEOPEN, DataType:=xlDelimited, Semicolon:=True, Local:=True, Origin:=65001
Dim lRow As Long
Dim lCol As Long
    
    'Find the last non-blank cell in column A(1)
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    'Find the last non-blank cell in row 1
    lCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
    Range(Cells(2, 1), Cells(lRow, lCol)).Copy

ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
    Set wkbTemp = Nothing
    Exit Sub


ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler

End Sub

For Excel 2016, it works fine with TXT files that were origionally CSV files. If you use the CSV file, Excel spits the dummy and you get scrambled eggs. Again, the TXT file is delimited as in my post above this one.

The biggest pain, is that you have to name your file 01.txt. Any suggestions on how to get around that with this code?

Cheers,
Rocko262c