Страницы: 1
RSS
Построчно прочитать текстовый файл с кириллицей в utf-8, вывести его содержимое на листе.
 
Здравствуйте, подскажите, пожалуйста, никак не получается решить самой. Допустим, есть файл в кодировке utf-8, в котором текст на русском языке. Мне нужно считать этот файл построчно и вывести его на лист.

Я сумела нагуглить вот этот код:
Код
With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = False
    .Show

    Dim Row As Integer: Row = 1
    path = .SelectedItems(1)
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.OpenTextFile(path, 1)
    
    Do Until objFile.AtEndOfStream

        strLine = objFile.ReadLine
        Cells(Row, 1).Value = strLine
        Row = Row + 1
        
    Loop
    objFile.Close
End With

Он делает то, что мне нужно, за исключением того, что кириллица переносится на лист вот в таком виде:
Цитата
†рџЋЇр
Каким образом это можно исправить?
 
Почему макрос ?
Например:
Данные => Импорт из текстового файла => Кодирование 65001 (UTF _ 8 .)
Изменено: ocet p - 08.02.2020 01:36:40
 
Цитата
ocet p написал:
Почему макрос ?
Дело в том, что файл достаточно большой, а мне нужны не все подряд строки, а только некоторые, поэтому в макросе я условием проверяю - нужная ли строка или нет. И если она нужна - тогда записываю в ячейку, если нет - пропускаю.  
 
Цитата
elegi2003 написал:
а только некоторые,
- можно только их и конвертнуть. Но сейчас некогда код искать, но вообще лучше иметь образец такого файла.
Можно пробовать
Код
Public Declare Function MultiByteToWideCharA Lib "kernel32.dll" Alias "MultiByteToWideChar" ( _
    ByVal CodePage As Long, ByVal dwFlags As Long, _
    ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, _
    ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long

Public Function DecodeUTF8(ByVal sInput As String) As String
Dim iStrSize As Long, lMaxSize As Long, str1 As String
Dim p As Long
Dim str2 As String
    If Len(sInput) = 0 Then Exit Function

    lMaxSize = Len(sInput)
    str1 = String$(lMaxSize, 0&)
    iStrSize = MultiByteToWideCharA(65001, 0&, sInput, &HFFFF, StrPtr(str1), lMaxSize)
    If iStrSize > 0 Then
        DecodeUTF8 = Left$(str1, iStrSize - 1)
    Else
        DecodeUTF8 = sInput
    End If
End Function
Изменено: Hugo - 08.02.2020 02:19:44
 
Цитата
elegi2003 написал:
файл достаточно большой, а мне нужны не все подряд строки, а только некоторые
Зачем сразу не написали ?
Так каков размер этого файла, что он не подходит excel ?
Попробуйте так, но вы не предоставили достаточно информации о файлах для обработки:
Код
Option Explicit

Sub utfe_8()
    Const fltr = "CSV Files (*.csv),*.csv,TXT Files (*.txt),*.txt"
    '--------------------------------------------------------------
    ' https://docs.microsoft.com/en-us/sql/ado/reference/ado-api/stream-object-ado?view=sql-server-ver15
    ' ADODB.Stream
    '--------------------------------------------------------------
    'Charset => HKEY_CLASSES_ROOT\MIME\Database\Charset
        Const chrst = "utf-8"
    'StreamTypeEnum
        Const adTypeBinary = 1
        Const adTypeText = 2
    'SaveOptionsEnum
        Const adSaveCreateNotExist = 1
        Const adSaveCreateOverWrite = 2
    'StreamWriteEnum
        Const adWriteChar = 0
        Const adWriteLine = 1
    'StreamReadEnum
        Const adReadAll = -1 ' The default value
        Const adReadLine = -2
    'LineSeparatorsEnum
        Const adCR = 13
        Const adLF = 10
        Const adCRLF = -1
    '--------------------------------------------------------------
    Dim fle
    fle = Application.GetOpenFilename(fltr, 2, "UTF-8", , False)
    If TypeName(fle) = "Boolean" Then Exit Sub
    'fle = "C:\Temp\PrimerUTF-8.txt"
    'fle = Right(fle, Len(fle) - InStrRev(fle, "\", -1, 1))
    '--------------------------------------------------------------
    Dim r&, strline, utf8 As Object
    '--------------------------------------------------------------
    Set utf8 = CreateObject("ADODB.Stream")
    utf8.Type = adTypeText
    utf8.Charset = chrst
    utf8.LineSeparator = adCRLF
    utf8.Open
    'utf8.LoadFromFile ThisWorkbook.Path & "\" & fle
    utf8.LoadFromFile fle
    '--------------------------------------------------------------
    utf8.Position = 0 ' posle 'LoadFromFile' ne obyazatel'no
    '--------------------------------------------------------------
    Do Until utf8.EOS
        strline = utf8.ReadText(adReadLine)
        If Trim(strline) <> "" Then
            If strline Like "##." Or strline Like "*####*" Then
                'MsgBox Left(strline, 32)
                '???
            Else
                r = r + 1
                Range("A" & r).Value = Application.Clean(strline)
            End If
        End If
    Loop
    '--------------------------------------------------------------
    utf8.Close
    Set utf8 = Nothing
End Sub

Работает с тестовым файлом:
 
Доброе время суток
Ну, Utf-8 текст может и Power Query и фильтровать по ходу выполнения тоже можно.
 
Большое спасибо все ответившим! Вы очень помогли.  Код  
Цитата
ocet p написал:
Попробуйте так
сделал именно то, над чем я безуспешно билась в течение нескольких дней!

Огромное всем спасибо, вопрос полностью решен!
 
Можно и в тот первый код внедрить показанную функцию, подскажу как раз не умеете:
Код
Cells(Row, 1).Value = DecodeUTF8(strLine)
Изменено: Hugo - 08.02.2020 22:28:30
 
Hugo, спасибо! Попробую и ваш вариант тоже.  
 
Но не забудьте - в проекте должен быть модуль с тем кодом, что я дал выше. Можно в этом же модуле всё рядом положить.
Изменено: Hugo - 08.02.2020 22:36:42
 
Я понимаю, да)
Страницы: 1
Наверх