ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 2305|回复: 11

[求助] VBA网抓,对网页内容再编辑

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-10-10 14:03 | 显示全部楼层 |阅读模式
vba常用的都能够会,但是网抓不会。有没有大神帮忙看看啊!
网址http://www.lspipe.cn:8888/erp/login_now/?next=/
账号:浏览账号
密码:123456
要导出,在产管理表到Excel进行再编辑开发。
image.png image.png

TA的精华主题

TA的得分主题

发表于 2019-10-10 16:15 | 显示全部楼层
Sub test()
    Dim winhttp As Object
    Dim token As String
    Dim senddata As String
    Dim json As Object
    Set winhttp = CreateObject("winhttp.winhttprequest.5.1")
    With winhttp
        .Open "GET", "http://www.lspipe.cn:8888/erp/login_now/?next=/", False
        .setrequestheader "Host", "www.lspipe.cn:8888"
        .send
        If .Status = 200 Then
            token = Split(Split(.getallresponseheaders, "Set-Cookie: csrftoken=")(1), ";")(0)
            senddata = "csrfmiddlewaretoken=" & token & "&username=%E6%B5%8F%E8%A7%88%E8%B4%A6%E5%8F%B7&password=123456"
            .Open "POST", "http://www.lspipe.cn:8888/erp/login_now/?next=/erp/index/", False
            .setrequestheader "Host", "www.lspipe.cn:8888"
            .setrequestheader "Content-Type", "application/x-www-form-urlencoded"
            .setrequestheader "Referer", "http://www.lspipe.cn:8888/erp/login_now/?next=/erp/index/"
            .send senddata
            .Open "POST", "http://www.lspipe.cn:8888/erp/inners/list/", False
            .setrequestheader "Host", "www.lspipe.cn:8888"
            .setrequestheader "Content-Type", "application/x-www-form-urlencoded"
            .setrequestheader "Referer", "http://www.lspipe.cn:8888/erp/page/inners/"
            .send
            With CreateObject("msscriptcontrol.scriptcontrol")
                .Language = "jscript"
                .addcode "var mydata=" & winhttp.responsetext
                Set json = .codeobject.mydata.inners
            End With
        End If
    End With
End Sub

取了json
接下來懂了嗎

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-10-10 21:19 来自手机 | 显示全部楼层
超過5小時還沒審批完,打了的代碼石沈大海,再這樣真的沒發貼的動力了

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-10-11 09:25 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
chis3 发表于 2019-10-10 16:15
Sub test()
    Dim winhttp As Object
    Dim token As String

我来试试,谢谢

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-10-12 14:28 | 显示全部楼层
chis3 发表于 2019-10-10 16:15
Sub test()
    Dim winhttp As Object
    Dim token As String

有个问题,代码好像不能翻页,只能抓取第一页内容。

TA的精华主题

TA的得分主题

发表于 2019-10-12 14:58 | 显示全部楼层
475039349 发表于 2019-10-12 14:28
有个问题,代码好像不能翻页,只能抓取第一页内容。

Sub test()
    Dim winhttp As Object
    Dim token As String
    Dim senddata As String
    Dim json As Object
    Set winhttp = CreateObject("winhttp.winhttprequest.5.1")
    With winhttp
        j = 0
        For i = 1 To 200
            .Open "GET", "http://www.lspipe.cn:8888/erp/login_now/?next=/", False
            .setrequestheader "Host", "www.lspipe.cn:8888"
            .send
            token = Split(Split(.getallresponseheaders, "Set-Cookie: csrftoken=")(1), ";")(0)
            senddata = "csrfmiddlewaretoken=" & token & "&username=%E6%B5%8F%E8%A7%88%E8%B4%A6%E5%8F%B7&password=123456"
            .Open "POST", "http://www.lspipe.cn:8888/erp/login_now/?next=/erp/index/", False
            .setrequestheader "Host", "www.lspipe.cn:8888"
            .setrequestheader "Content-Type", "application/x-www-form-urlencoded"
            .setrequestheader "Referer", "http://www.lspipe.cn:8888/erp/login_now/?next=/erp/index/"
            .send senddata
            .Open "POST", "http://www.lspipe.cn:8888/erp/inners/list/", False
            .setrequestheader "Host", "www.lspipe.cn:8888"
            .setrequestheader "Content-Type", "application/x-www-form-urlencoded"
            .setrequestheader "Referer", "http://www.lspipe.cn:8888/erp/page/inners/"
            .send "start=" & j & "&length=100"
            With CreateObject("msscriptcontrol.scriptcontrol")
                .Language = "jscript"
                .addcode "var mydata=" & winhttp.responsetext
                Set json = .codeobject.mydata.inners
            End With
            j = i * 100
        Next i
    End With
End Sub

评分

2

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-10-19 19:43 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
chis3 发表于 2019-10-12 14:58
Sub test()
    Dim winhttp As Object
    Dim token As String

object 对象型的变量,我不会转换类型,并写入单元格。并且网上也没有什么资源学习,找了好久还是基本上没有什么收获。还要请您解释下!

TA的精华主题

TA的得分主题

发表于 2019-10-19 20:51 | 显示全部楼层
475039349 发表于 2019-10-19 19:43
object 对象型的变量,我不会转换类型,并写入单元格。并且网上也没有什么资源学习,找了好久还是基本上 ...

你不清楚什麼?
不會沒資源學習啊,我都是在這找資源學的,多搜索和看知識樹,精華

TA的精华主题

TA的得分主题

发表于 2019-10-19 21:19 来自手机 | 显示全部楼层
475039349 发表于 2019-10-19 19:43
object 对象型的变量,我不会转换类型,并写入单元格。并且网上也没有什么资源学习,找了好久还是基本上 ...

需要进一步咋处理?
分类汇总?
这个表 看不出来 有啥特点或者说是优点?

TA的精华主题

TA的得分主题

发表于 2019-10-19 21:23 来自手机 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
zpy2 发表于 2019-10-19 21:19
需要进一步咋处理?
分类汇总?
这个表 看不出来 有啥特点或者说是优点?

好像搜索不太起作用,界面还行,用了datatable的UI组件,功能感觉不是很丰富。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 12:56 , Processed in 0.052111 second(s), 11 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表