网抓技巧-复制网页表格，不用遍历单元格

592rmb

好东西，留下学习

liuzhitristan

论坛大神多，新手学习了

qx-liuwx

请教老师: 我这个帖子用老师第二个代码能下载 该网页的第一个表格。
https://club.excelhome.net/thread-1628649-1-1.html

但如何下载该网页的第2个表格、还请老师指导。谢谢！

perfect131

qx-liuwx 发表于 2022-5-25 19:31
请教老师: 我这个帖子用老师第二个代码能下载 该网页的第一个表格。
https://club.excelhome.net/thread-1 ...

http://q.10jqka.com.cn/gn/detail ... 1?qq-pf-to=pcqq.c2c
参考五楼，加外循环，http://q.10jqka.com.cn/gn/detail/field/264648/order/desc/page/" & x &"/ajax/1/code/308941?qq-pf-to=pcqq.c2c

perfect131

qx-liuwx 发表于 2022-5-25 19:31
请教老师: 我这个帖子用老师第二个代码能下载 该网页的第一个表格。
https://club.excelhome.net/thread-1 ...

加外循环，仅参考

qx-liuwx

cookie时时变

perfect131

当出现自动化这类错误时可以试试 VBS 爬虫
简单版的 VBS+VBA 复制网页表格，不用遍历单元格, 这里工作簿需要开着
VBS 代码

1. '    Set winhttp = CreateObject("winhttp.WinHttpRequest.5.1")
   
2. '    Set winhttp = CreateObject("MSXML2.ServerXMLHTTP")
   
3. '    Set winhttp = CreateObject("MSXML2.XMLHTTP")
   
4.     Set winhttp = CreateObject("Microsoft.XMLHTTP")
   
5.     Url = "https://www.taiwanlottery.com.tw/Lotto/BINGOBINGO/drawing.aspx"
   
6.     With winhttp
   
7.         .Open "GET", Url, False
   
8.         '.setRequestHeader "User-Agent", ""
   
9.         .send
   
10.         strText = .responsetext
    
11.     End With
    
12.     Dim xlApp, xlBook
    
13.     Set xlApp = GetObject(, "Excel.Application")
    
14. '''对应的excel工作簿，对应的宏名称，工作簿名称有的电脑含中文会报错，可以试试 chcp 方法
    
15.     xlApp.Application.Run "Id.xlsm!tableTest",Cstr(strText)
    
16. Set winhttp =Nothing
    
17. Set xlApp = Nothing
    
18. WScript.Quit

复制代码

对应的excel工作簿 里的 VBA 代码

1. Sub tableTest(strText)
   
2.     Set HTML = CreateObject("htmlfile")
   
3.     Set oWindow = HTML.ParentWindow
   
4.     HTML.body.innerhtml = strText
   
5.     Set tables = HTML.getElementsByClassName("tableFull")
   
6.     Set Table = tables(0)
   
7.    
   
8.     '''写入剪切板 第一种
   
9.     oWindow.ClipboardData.SetData "text", Table.outerHTML
   
10.    
    
11.     '''写入剪切板 第二种
    
12. '    Set clipboard = New MSForms.DataObject
    
13. '    clipboard.SetText Table.outerHTML
    
14. '    clipboard.PutInClipboard
    
15. 
    
16.     ActiveSheet.Range("a1").Select
    
17.     ActiveSheet.Paste
    
18.    
    
19.     Set HTML = Nothing
    
20.     Set oWindow = Nothing
    
21. End Sub

复制代码

592rmb

这个真的很方便，留下学习了，谢谢

lwx228

perfect131 发表于 2022-5-25 19:59
加外循环，仅参考

请教老师、试了这个网站的表格下载、较麻烦、它是不断要更新cookie才能继续下载、如何能让VBA自动获取新的cookie、使能全自动下载齐各概念板块的列表。谢谢！

前进者

大神出品、必是精品！