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

perfect131

     其实我一直是遍历读取Table内容的，今天看到一个帖子求助类似于复制网页表格。我专门搜了一下，还真可以直接复制网页表格，这里我稍微改进了一下，应该有表格的网页都能通用。
参考：https://club.excelhome.net/thread-1192289-1-1.html

参考：https://stackoverflow.com/questi ... oping-through-cells

求助帖：https://club.excelhome.net/thread-1628185-1-2.html

1. ''''对应表格复制
   
2. Sub tableTest()
   
3.     Set winhttp = CreateObject("winhttp.WinHttpRequest.5.1")
   
4.     Set HTML = CreateObject("htmlfile")
   
5.     Set oWindow = HTML.ParentWindow
   
6.     Url = "https://www.taiwanlottery.com.tw/Lotto/BINGOBINGO/drawing.aspx"
   
7.     With winhttp
   
8.         .Open "GET", Url, False
   
9.         .send
   
10.         strText = .responsetext
    
11. ''            Debug.Print strText
    
12.     End With
    
13.     HTML.body.innerhtml = strText
    
14.     Set tables = HTML.getElementsByClassName("tableFull")
    
15.     Set Table = tables(0)
    
16.    
    
17.     '''写入剪切板 第一种
    
18.     oWindow.ClipboardData.SetData "text", Table.outerHTML
    
19.    
    
20.     '''写入剪切板 第二种
    
21. '    Set clipboard = New MSForms.DataObject
    
22. '    clipboard.SetText Table.outerHTML
    
23. '    clipboard.PutInClipboard
    
24. 
    
25.     ActiveSheet.Range("a1").Select
    
26.     ActiveSheet.Paste
    
27.    
    
28.     Set winhttp = Nothing
    
29.     Set HTML = Nothing
    
30.     Set oWindow = Nothing
    
31. End Sub
    
32. ''''所有表格
    
33. Sub alltableTest()
    
34.     Set winhttp = CreateObject("winhttp.WinHttpRequest.5.1")
    
35.     Set HTML = CreateObject("htmlfile")
    
36.     Set oWindow = HTML.ParentWindow
    
37.     Url = "https://www.taiwanlottery.com.tw/Lotto/BINGOBINGO/drawing.aspx"
    
38.     With winhttp
    
39.         .Open "GET", Url, False
    
40.         .send
    
41.         strText = .responsetext
    
42. ''            Debug.Print strText
    
43.     End With
    
44.     HTML.body.innerhtml = strText
    
45.     Set tables = HTML.getElementsByTagName("table")
    
46.     aa = 1
    
47.     For i = 0 To tables.Length - 1
    
48.         Set Table = tables(i)
    
49.         
    
50.         '''写入剪切板 第一种
    
51.         oWindow.ClipboardData.SetData "text", Table.outerHTML
    
52.         
    
53.         '''写入剪切板 第二种
    
54.     '    Set clipboard = New MSForms.DataObject
    
55.     '    clipboard.SetText Table.outerHTML
    
56.     '    clipboard.PutInClipboard
    
57.    
    
58.         ActiveSheet.Cells(1, aa).Select
    
59.         ActiveSheet.Paste
    
60.         oWindow.ClipboardData.SetData "text", ""
    
61.         aa = ActiveSheet.UsedRange.Columns.Count + 2
    
62.     Next
    
63.     Set winhttp = Nothing
    
64.     Set HTML = Nothing
    
65.     Set oWindow = Nothing
    
66. End Sub

复制代码

maxi20

谢谢楼主认真回复。
我复制进Excel里F8运行，可是在.sent 语句处 还是自动化错误。见下图。
是不是我电脑不行啊。。。我是XP系统.Exce l2007版本。能远程下不？

perfect131

maxi20 发表于 2022-5-23 22:13
谢谢楼主认真回复。
我复制进Excel里F8运行，可是在.sent 语句处 还是自动化错误。见下图。
是不是我电脑 ...

替换CreateObject("winhttp.WinHttpRequest.5.1")
可以用这些对象
CreateObject("MSXML2.XMLHTTP")   
CreateObject("Microsoft.XMLHTTP")
CreateObject("MSXML2.ServerXMLHTTP")
参考5楼：https://club.excelhome.net/forum ... 760&pid=6122066

shenzhenyang

1. ''''所有表格
   
2. Sub alltableTest()
   
3.     Set winhttp = CreateObject("winhttp.WinHttpRequest.5.1")
   
4.     Set HTML = CreateObject("htmlfile")
   
5.     Set oWindow = HTML.ParentWindow
   
6.     Url = "http://fx.cmbchina.com/Hq/History.aspx?nbr=%u7F8E%u5143&page=1" 'page=1这里的1是第1页，我要捉取网页的第1页和第2页，要怎么改
   
7. 
   
8.     With winhttp
   
9.         .Open "GET", Url, False
   
10.         .send
    
11.         strText = .responsetext
    
12. ''            Debug.Print strText
    
13.     End With
    
14.     HTML.body.innerhtml = strText
    
15.     Set tables = HTML.getElementsByTagName("table")
    
16.     aa = 1
    
17.     For i = 0 To tables.Length - 1
    
18.         Set Table = tables(i)
    
19.         
    
20.         '''写入剪切板 第一种
    
21.         oWindow.ClipboardData.SetData "text", Table.outerHTML
    
22.         
    
23.         '''写入剪切板 第二种
    
24.     '    Set clipboard = New MSForms.DataObject
    
25.     '    clipboard.SetText Table.outerHTML
    
26.     '    clipboard.PutInClipboard
    
27.    
    
28.         ActiveSheet.Cells(1, aa).Select
    
29.         ActiveSheet.Paste
    
30.         oWindow.ClipboardData.SetData "text", ""
    
31.         aa = ActiveSheet.UsedRange.Columns.Count + 2
    
32.     Next
    
33.     Set winhttp = Nothing
    
34.     Set HTML = Nothing
    
35.     Set oWindow = Nothing
    
36. End Sub
    

复制代码

Url = "http://fx.cmbchina.com/Hq/History.aspx?nbr=%u7F8E%u5143&page=1" 'page=1这里的1是第1页，我要捉取网页的第1页和第2页，要怎么改



麻烦老师帮我改下吗，谢谢

perfect131

shenzhenyang 发表于 2022-5-24 12:29
Url = "http://fx.cmbchina.com/Hq/History.aspx?nbr=%u7F8E%u5143&page=1" 'page=1这里的1是第1页，我要捉 ...

加一个外循环，把aa=1放在外循环外面
参考：

aecn

Mark一下，方便查询

shenzhenyang

perfect131 发表于 2022-5-24 14:51
加一个外循环，把aa=1放在外循环外面
参考：

Set winhttp = CreateObject("Microsoft.XMLHTTP")
我换成这个从第58列写入第2页的网页数据，

我想网页第2页从52行开始写入，不要第2页的标题，老师麻烦帮我看下，谢谢

lwx228

好吧、来个更简单的

perfect131

lwx228 发表于 2022-5-24 15:50
好吧、来个更简单的

不错，不过你这个感觉跟 excel pq一样，pq是自带的方便一点，还不如用pq

maxi20

perfect131 发表于 2022-5-24 09:27
替换CreateObject("winhttp.WinHttpRequest.5.1")
可以用这些对象
CreateObject("MSXML2.XMLHTTP")   
...

谢谢认真回复。
这语句CreateObject("winhttp.WinHttpRequest.5.1") 我换那几个了，F8都是.send时报错拷图样自动化错误，出错代码略不同。

我将你这两vba程序拷到邻居家，他是Win10系统，第二段所有表格vab程序可以运行的通。你既然发出这程序段,肯定是分析过那网页能运行的，那就是我Xp系统电脑不匹配呗.....
你介绍的论坛第5楼，我看的不明就里。
小白真难。。