For the work, I have to create a macro in Excel who select an Excel file and transform this File into CSV in UTF-8 encoding but I meet some problems.
First of all, this is my macro who select the file
Function FileSelected() As String
'Function to Open a file
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Filters.Clear
'.Filters.Add "Excel Files", "*.xlsx?", 1
.Title = "Choose an Excel file"
.AllowMultiSelect = False
If .Show = True Then
FileSelected = .SelectedItems(1)
End If
End With
The macro who convert in CSV
Function CSVConverted(fileToConvert As String) As String
Dim toConvertFile As String
Dim convertedFile As String
Dim Rows As Long
Dim Cols As Long
Dim J As Long
Dim K As Long
Dim sTemp As String
Dim sSep As String
Dim wb As Workbook
Const adCrLf As Long = -1
Const adModeUnknown As Long = 0
Const adSaveCreateOverWrite As Long = 2
Const adTypeText As Long = 2
sSep = ";!@#;" 'Specify the separator to be used
toConvertFile = fileToConvert
Workbooks.Open toConvertFile
Sheets(1).Activate
Dim fileExtension As String
fileExtension = Right(toConvertFile, Len(toConvertFile) - InStrRev(toConvertFile, "."))
If fileExtension = "xlsm" Or fileExtension = "xlsx" Or fileExtension = ".xlsb" Or fileExtension = ".xls" Then
toConvertFile = Mid(toConvertFile, 1, Len(toConvertFile) - Len(fileExtension))
convertedFile = toConvertFile & ".csv"
Open convertedFile For Output As 1
With ActiveSheet
'Number of rows to export is based on the contents
'of column J. If it should be based on a different
'column, change the following line to reflect the
'column desired.
Rows = .Cells(.Rows.Count, "J").End(xlUp).Row
For J = 1 To Rows
sTemp = ""
Cols = .Cells(J, .Columns.Count).End(xlToLeft).Column
For K = 1 To Cols
sTemp = sTemp & .Cells(J, K).Value
If K < Cols Then sTemp = sTemp & sSep
Next
Print #1, sTemp
Next J
End With
Close 1
sTemp = "There were " & Rows & " rows of data written "
sTemp = sTemp & "to this file:" & vbCrLf & toConvertFile
Else
sTemp = "This macro needs to be run on a workbook "
sTemp = sTemp & "stored in the XLSX, XLSM, XLSB or XLS format."
End If
ActiveWorkbook.Close
'Dim wbName As String
'wbName = Right(toConvertFile, Len(toConvertFile) - InStrRev(toConvertFile, "\"))
'For Each wb In Workbooks
' If wb.Name = wbName Then
' Workbooks.Close wbName
' Exit Sub
' End If
'Next
MsgBox sTemp
CSVConverted = convertedFile
But after this macro, my file is not in UTF-8, I made 2 macros for that but it doesn't work.
Sub ConvertUTF8(fileToConvert, fileToSave As String)
Dim fileToConvertPath, fileToSavePath As String
fileToConvertPath = fileToConvert
fileToSavePath = fileToSave
Set UTFStream = CreateObject("ADODB.Stream"): 'Create Stream object
UTFStream.Type = 2: 'Specify stream type – we want To save text/string data.
UTFStream.Charset = "utf-8": 'Specify charset For the source text data.
UTFStream.Open: 'Open the stream
UTFStream.LoadFromFile fileToConvertPath: 'And write the file to the object stream
UTFStream.SaveToFile fileToSavePath, 2: 'Save the data to the named path
'skip BOM
UTFStream.Position = 3
'copy UTFStream to BinaryStream
Set BinaryStream = CreateObject("adodb.stream")
BinaryStream.Type = adTypeBinary
BinaryStream.Mode = adModeReadWrite
BinaryStream.Open
'Strips BOM (first 3 bytes)
UTFStream.CopyTo BinaryStream
UTFStream.Flush
UTFStream.Close
'save to file
BinaryStream.SaveToFile FName, adSaveCreateOverWrite
BinaryStream.Flush
BinaryStream.Close
End Sub
This macro make an UTF-8 encoding but with BOM and in the file, the special characters are replaced
Sub WriteANSItoUF8WithoutBOM(fileToConvert, fileToSave As String)
Dim fileToConvertPath, fileToSavePath As String
fileToConvertPath = fileToConvert
fileToSavePath = fileToSave
Set UTFStream = CreateObject("adodb.stream")
Set ANSIStream = CreateObject("adodb.stream")
Set BinaryStream = CreateObject("adodb.stream")
ANSIStream.Type = adTypeText
ANSIStream.Mode = adModeReadWrite
ANSIStream.Charset = "iso-8859-1"
ANSIStream.Open
ANSIStream.LoadFromFile fileToConvertPath 'ANSI File
UTFStream.Type = adTypeText
UTFStream.Mode = adModeReadWrite
UTFStream.Charset = "UTF-8"
UTFStream.Open
ANSIStream.CopyTo UTFStream
UTFStream.Position = 3 'skip BOM
BinaryStream.Type = adTypeBinary
BinaryStream.Mode = adModeReadWrite
BinaryStream.Open
'Strips BOM (first 3 bytes)
UTFStream.CopyTo BinaryStream
BinaryStream.SaveToFile fileToSavePath, adSaveCreateOverWrite
BinaryStream.Flush
BinaryStream.Close
End Sub
And this macro create stays in ANSI encoding, I don't see the problem in this macro, just it's in ANSI.
Please can you can help, i'm lost