提取网页乱码

go0517

帮忙看一下，怎么修改，提取的数据，汉字才不会乱码。感谢。


Sub test()
    Dim strUrl As String, objHttp As Object, strRtn, arrRtn, i%, j, bytes2BSTR, TT
    strUrl = "http://www.bjciq.gov.cn:8989/data.do?cmd=query&id=1" & Replace(strUrl, "http://", "") '
    Set objHttp = CreateObject("Microsoft.XMLHTTP")
    objHttp.Open "GET", strUrl, False  
    objHttp.Send

    Rows(1).NumberFormatLocal = "@"     '第二行设置为文本格式
    strRtn = Split(objHttp.responsetext, "<table", -1, vbTextCompare)(8)    '取 "<table" 之后的内容
    strRtn = Split(strRtn, "</tr>", -1, vbTextCompare)    '以 "</tr>" 作为分隔符把数据分为行数组

    For i = 0 To UBound(strRtn)     '行循环
        arrRtn = Split(strRtn(i), "<td>", -1, vbTextCompare)        '各个字段以 "<td>" 分隔

        For j = 1 To UBound(arrRtn) '列循环
            Cells(i + 1, j + 1) = Replace(Split(arrRtn(j), "</td>", -1, vbTextCompare)(0), " ", "", 1, -1, vbTextCompare)
            Next j
    Next i
    Set objHttp = Nothing
End Sub

sz_wap

用IE吧

1. Sub test()
   
2. Set ieA = CreateObject("InternetExplorer.Application")
   
3. ieA.Visible = False
   
4. 
   
5. ieA.navigate "http://www.bjciq.gov.cn:8989/data.do?cmd=query&id=1"
   
6. Do Until ieA.Readystate = 4
   
7.    DoEvents
   
8. Loop
   
9. 
   
10. Set tr = ieA.document.getElementsByTagName("tr")
    
11. i = 0
    
12. For Each t In tr
    
13.     If t.Title <> "" Then
    
14.        i = i + 1
    
15.        For j = 0 To t.Cells.Length - 1
    
16.            Cells(i, j + 1) = t.Cells(j).innertext
    
17.        Next
    
18. End If
    
19. Next
    
20. 
    
21. ieA.Quit
    
22. End Sub

复制代码

ghostjiao

用.responsebody转码

coby001

<meta http-equiv="Content-Type" content="text/html; charset=gb2312">

网页的字符集是gb2312，

转码到 utf-8 就行了

雪舞子

1. Sub test()
   
2.     Dim strUrl As String, objHttp As Object, strRtn, arrRtn, i%, j, bytes2BSTR, TT
   
3.     strUrl = "http://www.bjciq.gov.cn:8989/data.do?cmd=query&id=1" & Replace(strUrl, "http://", "") '
   
4.     Set objHttp = CreateObject("Microsoft.XMLHTTP")
   
5.     objHttp.Open "GET", strUrl, False
   
6.     objHttp.Send
   
7.     Rows(1).NumberFormatLocal = "@"     '第二行设置为文本格式
   
8.     strRtn = Split(StrConv(objHttp.ResponseBody, vbUnicode), "<table", -1, vbTextCompare)(8)    '取 "<table" 之后的内容
   
9.     strRtn = Split(strRtn, "</tr>", -1, vbTextCompare)    '以 "</tr>" 作为分隔符把数据分为行数组
   
10. 
    
11.     For i = 0 To UBound(strRtn)     '行循环
    
12.         arrRtn = Split(strRtn(i), "<td>", -1, vbTextCompare)        '各个字段以 "<td>" 分隔
    
13. 
    
14.         For j = 1 To UBound(arrRtn) '列循环
    
15.             Cells(i + 1, j + 1) = Replace(Split(arrRtn(j), "</td>", -1, vbTextCompare)(0), " ", "", 1, -1, vbTextCompare)
    
16.             Next j
    
17.     Next i
    
18.     Set objHttp = Nothing
    
19. End Sub

复制代码

go0517

谢谢各位大神的帮忙