ExcelHome技术论坛

 找回密码
 免费注册
QQ登录 只需一步,快速开始
   
高效办公必会的Office99uu优优 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! 国内首部Excel函数公式学习大典 职场充电黑科技, Office微99uu优优 免费下载Excel行业应用视频
300集Office 2010微99uu优优 Tableau-数据可视化工具 突破Excel限制,用活字格提高效率 12门Excel免费公开课任你学
你的Excel 201099uu优优学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 162|回复: 5
打印 上一主题 下一主题

[求助] 关于VBA抓取网页内容的难题,希望高人指导!!!

[复制链接]
TA的精华主题TA的得分主题
跳转到指定楼层
1
发表于 2018-1-13 23:25 | 只看该作者 |只看大图 回帖奖励 |倒序浏览 |阅读模式
本人VBA初学,想得到:
http://www.zujuan.com/question/search?content=&xd=3&chid=4
网页的源码,由于才疏学浅,怎么也不成功,希望各位大侠指点一二,万分感谢!!!
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 有用有用 无用无用
TA的精华主题TA的得分主题
2
发表于 2018-1-14 14:34 | 只看该作者
Public Function GetCode(CodeBase, Url) '第一个参数是设置编码方式(utf-8或UTF-8)第二个参数是地址.
    On Error Resume Next
    Dim xmlHTTP1
    Set xmlHTTP1 = CreateObject("Microsoft.XMLHTTP")
    xmlHTTP1.Open "get", Url, True
    xmlHTTP1.send
    'If Err.Number <> 0 Then
        'MsgBox "Error " & Err.Number & " 错误描述:" & Err.Description & "<br>错误来源:" & Err.Source
   ' End If
    While xmlHTTP1.ReadyState <> 4
    DoEvents
    Wend
    GetCode = xmlHTTP1.responseBody
    If CStr(GetCode) <> "" Then
        GetCode = BytesToBstr(GetCode, CodeBase)
    Else
        GetCode = BytesToBstr(GetCode, CodeBase)
    End If
    Set xmlHTTP1 = Nothing
End Function
Public Function BytesToBstr(strBody, CodeBase)
    Dim ObjStream
    Set ObjStream = CreateObject("Adodb.Stream")
    With ObjStream
    .Type = 1
    .Mode = 3
    .Open
    .write strBody
    .Position = 0
    .Type = 2
    .Charset = CodeBase
    BytesToBstr = .ReadText
    .Close
    End With
    Set ObjStream = Nothing
End Function
Private Sub CommandButton1_Click()
    Dim dataTxt As String
    Set HTML = CreateObject("htmlfile")
    dataTxt = GetCode("UTF-8", "http://www.zujuan.com/question/search?content=&xd=3&chid=4")
    HTML.body.innerhtml = dataTxt

End Sub
得到源代。


TA的精华主题TA的得分主题
3
 楼主| 发表于 2018-1-15 21:54 | 只看该作者 |楼主
TA的精华主题TA的得分主题
4
 楼主| 发表于 2018-1-15 22:19 | 只看该作者 |楼主
本帖最后由 djf98 于 2018-1-16 08:51 编辑

大侠:
我用下面代码将代码保存:
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("C:\name.txt", 2, True)
f.writeline dataTxt
f.Close

然后复制到Microsoft Office SharePoint Designer中。结果显示如下图:
------------------------------------------------------------------------------------------------------------------------------------------------

----------------------------------------------------------------------------------------------------------------------------------------------------
c:\123.png
是否说明:DIV中的内容没有取到?
再次感谢!!!请麻烦您再看一下。
TA的精华主题TA的得分主题
5
 楼主| 发表于 2018-1-16 09:05 | 只看该作者 |楼主
本帖最后由 djf98 于 2018-1-16 09:08 编辑

另外:
**************************************************************

***************************************************************

***************************************************************
此处显示也不正确。(上图为代码模拟显示,下图为原网页。)
再次期待高人解答。

TA的精华主题TA的得分主题
6
 楼主| 发表于 2018-1-18 10:01 | 只看该作者 |楼主
您需要登录后才可以回帖 登录 | 免费注册
本版积分规则
关闭

最新热点上一条 /1 下一条

关注官方微信,每天坐享新鲜教程
手机版|关于我们|联系我们|ExcelHome    GMT+8, 2018-1-18 19:40 , Processed in 0.435617 second(s), 12 queries , Gzip On, MemCache On.
Powered by Discuz! X3.3 © 2001-2017 Wooffice Inc.
    沪公网安备 31011702000001号 沪ICP备11019229号 本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师
快速回复 返回顶部 返回列表
99uu优优