Импорт текста Unicode в лист Excel из источника в Интернете (html)

Question

Я использовал указанный ниже код для получения HTML исходного кода с веб-сайтов. У меня нет проблем с получением данных, которые находятся на английском языке sh. Но если они написаны на любом другом языке, я не могу импортировать этот текст, не превратив этот текст в gibberi sh.

Как я могу разрешить приведенный ниже код импортировать текст на другом языке в их фактической форме.

Sub test()
Dim FILENAME As String
Dim FileNum As Long

FILENAME = "C:\Temp\Source.txt"
FileNum = FreeFile


Open FILENAME For Output As FileNum
Print #FileNum, GetSource("https://www.pleasehelp.com/thankyou.html")
Close FileNum

    With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\TEMP\Source.txt", Destination:=Range("A1"))
    .Name = "Source"
    .AdjustColumnWidth = True
    .TextFileParseType = xlFixedWidth
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileColumnDataTypes = Array(2)
    .Refresh BackgroundQuery:=False
End With

End Sub

Function GetSource(sURL As String) As String
Dim oXHTTP As Object
Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
oXHTTP.Open "GET", sURL, False
oXHTTP.send
GetSource = oXHTTP.responsetext
Set oXHTTP = Nothing
End Function

Answer 1

Попробуйте использовать объект Stream вместо оператора Open для вывода в файл. Объект Stream позволяет установить набор символов в юникод для перевода содержимого. В следующем примере специально используется кодировка UTF-8.

Обратите внимание, что в коде используется раннее связывание, поэтому вам нужно установить ссылку (Visual Basic Editor >> Tools >> References) на Microsoft ActiveX Data Objects x.x. Library.

Option Explicit

Sub test()

    Dim outFile As String
    outFile = "C:\Temp\Source.txt"

    Dim stream As ADODB.stream
    Set stream = New ADODB.stream
    With stream
        .Charset = "UTF-8"
        .Mode = adModeReadWrite
        .Type = adTypeText
        .Open
        .WriteText GetSource("https://www.pleasehelp.com/thankyou.html")
        .SaveToFile outFile, adSaveCreateOverWrite 'overwrites any already existing file
        .Close
    End With

    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & outFile, Destination:=Range("A1"))
        .Name = "Source"
        .AdjustColumnWidth = True
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileColumnDataTypes = Array(2)
        .Refresh BackgroundQuery:=False
    End With

End Sub