抓取html 中文乱码,利用代码抓取网页数据,出现中文乱码问题

嗯,多谢你解答。试验了,出现了另外一种乱码,自己又再次琢磨了http://club.excelhome.net/thread-893760-1-1.html这个帖子的第一帖,问题解决了,原因是'因为XMLHTTP默认是UTF-8(原网页正是 此编码格式),不能识别gb2312,会发现数据乱码,所以不能采用.responsetext对象来得到字符串。

Sub te4t()

Dim strRespText$, tt$, i&, DW$

On Error Resume Next

For i = 3 To 4

a = Cells(i, 1).Value

With CreateObject("Microsoft.XMLHTTP")

.Open "GET", a, False                                              '要抓取的链接,"GET"尽量用大写,以免某些系统不兼容

.Send

tt = .responsetext

With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")    'DataObject对象,数据放入剪贴板,记事本观察数据

.SetText tt                                                    '因为XMLHTTP默认是UTF-8,不能识别gb2312,会发现数据乱码

.PutInClipboard                                                '所以不能采用.responsetext对象来得到字符串

End With

Set BytesToBstr = Server.CreateObject("Adodb.Stream")

tt = BytesToBstr(.responsebody, "GB2312")                          '因此要用Adodb.Stream对象

'tt = StrConv(.ResponseBody, vbUnicode, &H804)                     '或者StrConv函数,从.ResponseBody得到字符串

'tt = StrConv(.ResponseBody, vbUnicode)                            '因网页为GB2312,简体版的操作系统也可以不写第三个参数

With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")    '得到的字符串放入剪贴板,记事本观察数据

.SetText tt                                                    '数据正常显示,可以提取了

.PutInClipboard

End With

Cells(i, 2).Value = WorksheetFunction.Substitute(Split(Split(tt, "

")(1), "")(0), Chr(10), " ")

Cells(i, 3).Value = WorksheetFunction.Substitute(Split(Split(tt, "16.spid"" target=""_blank"">")(1), "

For j = 1 To 100

Cells(i, 3 + j).Value = WorksheetFunction.Substitute(Split(Split(tt, "")(j), "

If Cells(i, 3 + j) = "" Then GoTo xiayige

Next

xiayige:

End With

Next

MsgBox "【完】"

End Sub

换成这个代码问题就解决了。

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值