Как сохранить набор символов при экспорте таблицы Excel в .csv UTF8 без спецификации с использованием VBA?

Question

Я прочитал несколько других ответов о том, как экспортировать таблицу в .csv с кодировкой UTF8 (без спецификации). Я нашел код, который у меня почти работает, см. Ниже.

Моя проблема в том, что таблица содержит символы swedi sh (ÅÄÖ), и при открытии файла .csv они теряются до того, что выглядит неправильная кодировка. Я нашел обходной путь: открыть CSV-файл в Блокноте, сохранить, а затем открыть его в Excel. Обходной путь позволяет Excel правильно отображать буквы, но я бы предпочел не использовать дополнительный шаг. Можно ли изменить приведенный ниже код, чтобы кодировка не была потеряна?

Option Explicit

Sub CSVFileAsUTF8WithoutBOM()
Dim SrcRange As Range
Dim CurrRow As Range
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim FName As Variant
Dim UTFStream As Object
Dim BinaryStream As Object

' ADO Constants
Const adTypeBinary = 1 ' The stream contains binary data
Const adTypeText = 2 ' The stream contains text data (default)
Const adWriteLine = 1 ' write text string and a line separator (as defined by the LineSeparator property) to the stream.
Const adModeReadWrite = 3 ' Read/write
Const adLF = 10 ' Line feed only - default is carriage return line feed (adCRLF)
Const adSaveCreateOverWrite = 2 ' Overwrites the file with the data from the currently open Stream object, if the file already exists

' Open this workbook location
ChDrive Left(ThisWorkbook.Path, 1)
ChDir ThisWorkbook.Path

' ask for file name and path
  FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")

' prepare UTF-8 stream
  Set UTFStream = CreateObject("adodb.stream")
  UTFStream.Type = adTypeText
  UTFStream.Mode = adModeReadWrite
  UTFStream.Charset = "UTF-8"
  UTFStream.LineSeparator = adLF
  UTFStream.Open

  'set field separator
  ListSep = ";"
  'set source range with data for csv file
  If Selection.Cells.Count > 1 Then
    Set SrcRange = Selection
  Else
    Set SrcRange = ActiveSheet.UsedRange
  End If

  For Each CurrRow In SrcRange.Rows
    CurrTextStr = ""
    For Each CurrCell In CurrRow.Cells
      CurrTextStr = CurrTextStr & Replace(CurrCell.Value, """", """""") & ListSep
    Next
    'remove ListSep after the last value in line
    While Right(CurrTextStr, 1) = ListSep
      CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
    Wend
    'add line to UTFStream
    UTFStream.WriteText CurrTextStr, adWriteLine ' Writes character data to a text Stream object
  Next

  'skip BOM
  UTFStream.Position = 3 ' sets or returns a long value that indicates the current position (in bytes) from the beginning of a Stream object

  'copy UTFStream to BinaryStream
  Set BinaryStream = CreateObject("adodb.stream")
  BinaryStream.Type = adTypeBinary
  BinaryStream.Mode = adModeReadWrite
  BinaryStream.Open ' Opens a Stream object

  'Strips BOM (first 3 bytes)
  UTFStream.CopyTo BinaryStream ' Copies a specified number of characters/bytes from one Stream object into another Stream object

  UTFStream.Flush ' Sends the contents of the Stream buffer to the associated underlying object
  UTFStream.Close ' Closes a Stream object

  'save to file
  BinaryStream.SaveToFile FName, adSaveCreateOverWrite
  BinaryStream.Flush ' Sends the contents of the Stream buffer to the associated underlying object
  BinaryStream.Close ' Closes a Stream object

End Sub

Answer 1

РЕДАКТИРОВАТЬ:

Основываясь на вашем комментарии, я понимаю, что вы изначально хотели сохранить информацию о кодировке символов внутри файла без BOM .

Проблема с этим вопросом (как вы это поняли) заключается в том, что спецификация - это фактически то, что обычно содержит информацию о кодировке символов, и размещение этой информации где-либо еще в файле на самом деле не имеет смысла.

Итак, ваш код действительно идеально подходит для решения поставленной задачи. Что необходимо изменить, так это то, как файл CSV импортируется / открывается программным обеспечением, которое вы хотите использовать.

Если файл не имеет спецификации, программа, читающая файл, должна угадать кодировка символов.

В общем, если используемое вами программное обеспечение не поддерживает спецификации и неправильно угадывает, должен быть, по крайней мере, способ настроить поведение импорта / команда open, чтобы вы могли указать кодировку символов (похоже, вы ее нашли).

Исходный ответ:

По какой-то причине Excel с трудом угадайте кодировку символов при открытии файла CSV в кодировке UTF-8, просто дважды щелкнув файл. Вы должны немного помочь ему ...

Вместо того, чтобы открывать его напрямую, вы можете загрузить содержимое CSV в новую книгу, используя (устаревший) Мастер импорта текста и выбрав Набор символов UTF-8 (65001) во время импорта, если Excel не может определить это самостоятельно.

Если бы вы записали макрос во время его выполнения и превратили его в подпроцедуру, у вас могло бы быть что-то например:

Sub OpenCSV(FullFileName As String)

    Dim wb As Workbook
    Set wb = Workbooks.Add
    
    Dim ws As Worksheet
    Set ws = wb.Sheets(1)

    With ws.QueryTables.Add(Connection:= _
        "TEXT;" & FullFileName, Destination:=Range( _
        "$A$1"))
        .Name = "CSV_Open"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    
End Sub

Другое предложение

Если вы действительно хотите иметь возможность дважды щелкнуть файл вместо использования мастера импорта текста или запуска макроса , вы всегда можете создать процедуру события VBA в надстройке или PERSONAL.XSLB, запускаемую каждый раз при открытии книги.

Если он обнаруживает, что только что открытый файл является файлом CSV, он может закрыть его и «повторно открыть», используя приведенный выше код.

Дополнительно: Интересно: есть вопрос здесь о том, как изменить кодировку символов по умолчанию, которую использует Excel .