Convert CSV to XLSX keeping columns and unicode

[chilly_bang]

I have a directory with semicolon-delimited CSV files containing unicode signs. I try to convert them to XLSX using the solution from this thread, but fail in important parts:
the code makes XLSX from CSV, but all CSV data comes into the same column and all unicode signs are broken. However, if i use manually the legacy import wizard, with delimiter and collation selection, importing of CSV succeed always.

What should be adjusted in this code to keep columns and unicode healthy? An example of the data i work with is here: https://ufile.io/02e5bz6h

[COLOR=#333333]Sub ConvertCSVToXlsx()[/COLOR]    
    Dim myfile As String
    Dim oldfname As String, newfname As String
    Dim workfile
    Dim folderName As String
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
'   Capture name of current file
    myfile = ActiveWorkbook.Name
    
'   Set folder name to work through
    folderName = "C:\Test\"
    
'   Loop through all CSV filres in folder
    workfile = Dir(folderName & "*.CSV")
    Do While workfile <> ""
'       Open CSV file
        Workbooks.Open Filename:=folderName & workfile
'       Capture name of old CSV file
        oldfname = ActiveWorkbook.FullName
'       Convert to XLSX
        newfname = folderName & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & ".xlsx"
        ActiveWorkbook.SaveAs Filename:=newfname, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close
'       Delete old CSV file
        Kill oldfname
        Windows(myfile).Activate
        workfile = Dir()
    Loop
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 [COLOR=#333333]End Sub[/COLOR]

 

[John_w]

Try this macro:

Public Sub Convert_CSV_To_XLSX()
    
    Dim folderPath As String, csvFileName As String
    Dim csvWorkbook As Workbook
    Dim qt As QueryTable
    
    folderPath = "C:\Test\"
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
            
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
            
    Set csvWorkbook = Workbooks.Add(xlWBATWorksheet)

    csvFileName = Dir(folderPath & "*.csv")
    Do While csvFileName <> vbNullString
    
        csvWorkbook.Worksheets(1).Cells.ClearContents
        Set qt = csvWorkbook.Worksheets(1).QueryTables.Add(Connection:="TEXT;" & folderPath & csvFileName, Destination:=csvWorkbook.Worksheets(1).Range("A1"))
        With qt
            .TextFileParseType = xlDelimited
            .TextFileSemicolonDelimiter = True
            .TextFilePlatform = 65001
            .Refresh BackgroundQuery:=False
        End With
        qt.Delete
        
        'Save as .xlsx file and delete original .csv file
        
        csvWorkbook.SaveAs FileName:=folderPath & Left(csvFileName, InStrRev(csvFileName, ".") - 1) & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        Kill folderPath & csvFileName
        
        csvFileName = Dir()
    Loop
    
    csvWorkbook.Close False
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub