用VBA抓取网页内的数据

嘉天下 · 发表于 2018-1-20 21:30

各位大神，我想通过VBA抓取这个网站的数据，https://www.jisilu.cn/data/stock/dividend_rate/#cn  由于刚刚学习VBA，在home里学习很多前辈的抓取代码进行改造，但是无法成功，麻烦哪位大神帮忙修正一下，谢谢！
Sub test()
Dim HTML, URL
Set HTML = CreateObject("htmlfile")
URL = "https://www.jisilu.cn/data/stock/dividend_rate/#cn"
With CreateObject("msxml2.xmlhttp")
      .Open "get", URL, False
      .send
      HTML.body.innerhtml = .responsetext
      Set tb = HTML.all.tags("table")(7).Rows
      For i = 0 To tb.Length - 9
         For j = 0 To tb(i).Cells.Length - 1
            Cells(i + 1, j + 1) = tb(i).Cells(j).innertext
         Next
      Next
End With
End Sub

aman1516 · 发表于 2018-1-20 22:29

试试：

Sub GXPX()
Dim ie, dmt, r, i, j, k
Set ie = CreateObject("internetexplorer.application")
On Error Resume Next
Application.DisplayAlerts = False
Cells.Clear
With ie
.Navigate "https://www.jisilu.cn/data/stock/dividend_rate/#cn"
While ie.ReadyState <> 4 Or ie.Busy
DoEvents
Wend
Set dmt = .Document
Set r = dmt.All.tags("table")(0).Rows
For k = 0 To r.Length - 1
For j = 0 To r(k).Cells.Length - 1
Cells(k + 1, j + 1) = r(k).Cells(j).innerText
Next j
Next k
End With
Columns("B:Z").Columns.AutoFit
Set ie = Nothing
Set dmt = Nothing
Set r = Nothing
Application.DisplayAlerts = True
End Sub

复制代码

aman1516 · 发表于 2018-1-20 22:31

参考附件:

最新股息率排行榜.rar (33.33 KB, 下载次数: 1260)

嘉天下 · 发表于 2018-1-20 22:40

aman1516 发表于 2018-1-20 22:31
参考附件:

感谢前辈，谢谢！！！

vix01 · 发表于 2019-7-7 20:43

aman1516 发表于 2018-1-20 22:29
试试：

虽然我不是用于楼主的目的，但根据您的代码，解决了我的问题，先表示十分感谢！
在实际使用当中发现，我照您的代码思路，有的时候正常，有的时候不正常，在有的机器上正常，在有些机器上完全不运行，百思不得其解，逐步排查，发现IE在创建的时候会启动一个进程，在调用navigate的时候又会启动一个进程，会造成获得的句柄不是新开启的那个进程，这时候自然不会正常获得数据，后来想了个笨办法，用shell里的一个属性，获得所有窗口的URL,找出来正确的那个进程句柄，后来再没有出现问题，现贴出来分享一下，希望能找到一个更简洁的办法来解决这个问题。

Sub GXPX()
Dim IE, dmt, r, i, j, k
Set IE = CreateObject("internetexplorer.application")
Set sh = CreateObject("shell.application")
On Error Resume Next
Application.DisplayAlerts = False
Cells.Clear
With IE
.Navigate "https://www.jisilu.cn/data/stock/dividend_rate/#cn"
While IE.ReadyState <> 4 Or IE.Busy
DoEvents
Wend
Do
For Each eachIE In sh.Windows
If InStr(1, eachIE.locationURL, "https://www.jisilu.cn/data/stock/dividend_rate/#cn") Then
Set IE = eachIE
Exit Do
End If
Next eachIE
Loop
Set dmt = .Document
Set r = dmt.All.tags("table")(0).Rows
For k = 0 To r.Length - 1
For j = 0 To r(k).Cells.Length - 1
Cells(k + 1, j + 1) = r(k).Cells(j).innerText
Next j
Next k
End With
Columns("B:Z").Columns.AutoFit
IE.Quit
Set IE = Nothing
Set dmt = Nothing
Set r = Nothing
Set sh = Nothing
Application.DisplayAlerts = True
End Sub

复制代码

kkkkzhou · 发表于 2019-8-8 10:33

vix01 发表于 2019-7-7 20:43
虽然我不是用于楼主的目的，但根据您的代码，解决了我的问题，先表示十分感谢！
在实际使用当中发现，我 ...

我直接复制代码但是提示automation 错误，8888ffff，或者显示类未注册，但是我在引用里已经勾选了Microsoft internet control

徐敏徐敏 · 发表于 2019-8-19 16:23

aman1516 发表于 2018-1-20 22:29
试试：

这个怎么改呢？求大神赐教

trustme007 · 发表于 2019-9-21 10:24

在    While IE.ReadyState <> 4 Or IE.Busy
         DoEvents
   Wend
这个循环后面加入下面一段就OK了
  t = Timer
   Do Until Timer > t + 1
      DoEvents
   Loop
这是加入时间等待网页完全加载好，才能读取到表格，上面那个循环并不能保证加载好。
另外注意Set r = dmt.All.tags("table")(0).Rows中表格的编号是否是0，在集思录里同一个页面可能有多个标签，第几个标签就是第几张表

whiskey18 · 发表于 2020-1-4 22:59

正在研究集思录的数据抓取，谢谢大神！

tinavv123 · 发表于 2021-11-20 17:52

kkkkzhou 发表于 2019-8-8 10:33
我直接复制代码但是提示automation 错误，8888ffff，或者显示类未注册，但是我在引用里已经勾选了Microso ...

请问对于这个问题后来有方法解决吗

		自动登录	找回密码
密码			免费注册

[求助] 用VBA抓取网页内的数据

评分

评分