VBA - 将字符串转换为UNICODE

5

我需要将包含西里尔字母和拉丁字母符号的字符串HTML转换为UNICODE。

我尝试了以下方法:

Public HTML As String
    Sub HTMLsearch()

    GetHTML ("http://nfs.mobile.bg/pcgi/mobile.cgi?act=3&slink=6jkjov&f1=1")
    MsgBox HTML
    HTML = StrConv(HTML, vbUnicode)
    MsgBox HTML
End Sub

Function GetHTML(URL As String) As String
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .Send
        HTML = .ResponseText
    End With
End Function

您可以看到 StrConv 之前和之后的内容。如果您希望将 HTML 存储到文件中,可以使用以下代码:

Public HTML As String
    Sub HTMLsearch()

    GetHTML ("http://nfs.mobile.bg/pcgi/mobile.cgi?act=3&slink=6jkjov&f1=1")

    Dim path As String

    path = ThisWorkbook.path & "\html.txt"
    Open path For Output As #1
    Print #1, HTML
    Close #1

    HTML = StrConv(HTML, vbUnicode)

    path = ThisWorkbook.path & "\htmlUNICODE.txt"
    Open path For Output As #1
    Print #1, HTML
    Close #1
End Sub

Function GetHTML(URL As String) As String
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .Send
        HTML = .ResponseText
    End With
End Function

有什么想法吗?

解释代码与您期望/想要的功能之间的关系会有所帮助。即,这里的实际问题是什么? - Tim Williams
2个回答

13

VBA 对 Unicode 的支持并不是很好。

虽然可以处理 Unicode 字符串,但您无法通过 Debug.PrintMsgBox 查看实际字符-它们将显示为 ?

您可以在“控制面板 > 区域和语言 > 管理”选项卡中将“非 Unicode 程序的当前语言”设置为“俄语”,然后切换到不同的代码页,这样就可以在 VBA 消息框中看到 Cyrillic 字母而不是问号。但这只是表面上的改变。


你真正的问题在这里是别的。

服务器(nfs.mobile.bg)将文档作为 Content-Type: text/html 发送,没有关于字符编码的信息。这意味着接收者必须自行确定字符编码。

浏览器通过查看响应字节流并进行猜测来完成此操作。在您的情况下,在 HTML 源中有一个有用的 <meta http-equiv="Content-Type" content="text/html; charset=windows-1251"> 标签。因此,字节流应该被解释为 Windows-1251,这恰好是 Windows 中的 Cyrillic ANSI 代码页。

所以,我们甚至没有使用 Unicode!

在没有任何其他信息的情况下,XMLHTTP 对象的 responseText 属性默认为 us-ascii。来自 Cyrillic 字母表的扩展字符不存在于 ASCII 中,因此它们将被转换为实际的问号并丢失。这就是为什么您不能对任何内容使用 responseText

但是,响应的原始字节仍然可用,在 responseBody 属性中,该属性是一个 Byte 数组。

在 VBA 中,您必须执行浏览器所做的同样的事情。您必须将字节流解释为某种字符集。ADODB.Stream 对象可以为您完成此操作,并且非常简单明了:

' reference: "Microsoft XML, v6.0" (or any other version)
' reference: "Microsoft ActiveX Data Objects 6.1 library" (or any other version)
Option Explicit

Sub HTMLsearch()
    Dim url As String, html As String
    
    url = "http://nfs.mobile.bg/pcgi/mobile.cgi?act=3&slink=6jkjov&f1=1"
    html = GetHTML(url, "Windows-1251")
    
    ' Cyrillic characters are supported in Office, so they will appear correctly
    ActiveDocument.Range.InsertAfter html
End Sub

Function GetHTML(Url As String, Optional Charset As String = "UTF-8") As String
    Dim request As New MSXML2.XMLHTTP
    Dim converter As New ADODB.stream
    
    ' fetch page
    request.Open "GET", Url, False
    request.send
    
    ' write raw bytes to the stream
    converter.Open
    converter.Type = adTypeBinary
    converter.Write request.responseBody
    
    ' switch the stream to text mode and set charset
    converter.Position = 0
    converter.Type = adTypeText
    converter.Charset = Charset
    
    ' read text characters from the stream, close the stream
    GetHTML = converter.ReadText
    converter.Close
End Function

我一直在使用MS Word,并且正确调用HTMLsearch()函数将西里尔文字符写入页面。然而,当我在MsgBox中查看时,它们仍然显示为?。但是,现在这只是一个显示问题,由于VBA创建的UI无法处理Unicode所致。


2
@ Tomalak:我认为我从未见过比您更好的答案和解释。非常感谢您的支持! - Trenera
1
例如,输入中的字节 0xC1 被解释为使用代码页 1251 的字符 Б,映射到 Unicode 中的 U+0431(CYRILLIC SMALL LETTER BE)(在内存中的 UTF-16 表示形式:2 字节 0x0431)。 - Tomalak
Tomalak的回答非常好,看起来很棒,我试着运行了一下,但最终在包含数百种语言的生产数据上并没有奏效。请看下面的我的回答,它是有效的。 - hamish
1
@Br.Bill 这是一个在存储库中的问题/解决方案线程,从总体上看似乎非常有用:https://github.com/VBA-tools/VBA-Web/issues/65 - Tomalak
1
谈论一个有教育意义的答案。这是阅读俄罗斯网站的直接方法 - 尽管_charset_是UTF-8,但你也解释了它。 - Gustav
显示剩余4条评论

5

我的生产订单数据来自许多国家。这是我能找到的唯一真正有效的VBA函数。

Private Const CP_UTF8 = 65001

Private Declare Function MultiByteToWideChar Lib "kernel32" ( _
   ByVal CodePage As Long, ByVal dwFlags As Long, _
   ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, _
   ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long


Public Function sUTF8ToUni(bySrc() As Byte) As String
   ' Converts a UTF-8 byte array to a Unicode string
   Dim lBytes As Long, lNC As Long, lRet As Long

   lBytes = UBound(bySrc) - LBound(bySrc) + 1
   lNC = lBytes
   sUTF8ToUni = String$(lNC, Chr(0))
   lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(bySrc(LBound(bySrc))), lBytes, StrPtr(sUTF8ToUni), lNC)
   sUTF8ToUni = Left$(sUTF8ToUni, lRet)
End Function

示例用法:

Dim sHTML As String
Dim bHTML() As Byte
bHTML = GetHTML("http://yoururlhere/myorderdata.php")
sHTML = sUTF8ToUni(bHTML)
sHTML = Mid(sHTML, 2)  'strip off Byte Order Mark: EF BB BF

1
你能解释一下“不起作用”的意思,并且给出一个函数失败的例子吗? - Tomalak
1
这个解决方案只能在Windows系统中运行。Mac上的Excel无法实现,因为它没有kernel32库。 - Br.Bill

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接