将Unicode文本从Web(html)源导入到excel工作表中

Question

我使用下面提到的代码从网站获取HTML源代码。我在获取英文数据时没有任何问题。但是如果他们使用的是其他语言，我就无法导入该文本而不将该文本转换为乱码。

如何允许下面的代码以实际形式导入其他语言的文本。

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对象允许用户将字符集设置为unicode以转换内容。下面的示例特别使用UTF-8编码。

注意，代码使用了早期绑定，因此您需要设置一个对Microsoft ActiveX Data Objects x.x. Library的引用(Visual Basic Editor >> Tools >> References)。

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