Сохранение TXT в кодировке

Пользователь

Сообщений: 235 Регистрация: 29.03.2017

04.04.2017 17:05:18

во вложенном файле есть макрос, нужно изменить код, чтобы созданный файл сохранялся в кодировку UTF-8 или UTF-8 без BOM, или сначала создавался файл в одной из указанных кодировок, а потом записывал указанный в макросе рэнж

Код

   Sub SaveAsTXT()
 Application.ScreenUpdating = False
   PartOfName = ActiveWorkbook.ActiveSheet.[A24]
    Range("J3:J75").Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:=PartOfName & [A1] & ".txt", _
        FileFormat:=xlUnicodeText, CreateBackup:=False
    ActiveWindow.Close SaveChanges = True
    Application.ScreenUpdating = True
End Sub

Изменено: MOTO - 06.04.2017 22:24:05

MOTO

Пользователь

Сообщений: 235 Регистрация: 29.03.2017

05.04.2017 00:39:34

как правильно вписать в этот код функцию

Код

Function SaveTextToFile(ByVal txt$, ByVal filename$, Optional ByVal encoding$ = "windows-1251") As Boolean
    ' функция сохраняет текст txt в кодировке Charset$ в файл filename$
    On Error Resume Next: Err.Clear
    Select Case encoding$
 
        Case "windows-1251", "", "ansi"
            Set FSO = CreateObject("scripting.filesystemobject")
            Set ts = FSO.CreateTextFile(filename, True)
            ts.Write txt: ts.Close
            Set ts = Nothing: Set FSO = Nothing
 
        Case "utf-16", "utf-16LE"
            Set FSO = CreateObject("scripting.filesystemobject")
            Set ts = FSO.CreateTextFile(filename, True, True)
            ts.Write txt: ts.Close
            Set ts = Nothing: Set FSO = Nothing
 
        Case "utf-8noBOM"
            With CreateObject("ADODB.Stream")
                .Type = 2: .Charset = "utf-8": .Open
                .WriteText txt$
 
                Set binaryStream = CreateObject("ADODB.Stream")
                binaryStream.Type = 1: binaryStream.Mode = 3: binaryStream.Open
                .Position = 3: .CopyTo binaryStream        'Skip BOM bytes
                .flush: .Close
                binaryStream.SaveToFile filename$, 2
                binaryStream.Close
            End With
 
        Case Else
            With CreateObject("ADODB.Stream")
                .Type = 2: .Charset = encoding$: .Open
                .WriteText txt$
                .SaveToFile filename$, 2        ' сохраняем файл в заданной кодировке
                .Close
            End With
    End Select
    SaveTextToFile = Err = 0: DoEvents
End Function