查看: 24818|回复: 31
vba抓取网页数据
阅读权限10
在线时间 小时
本帖最后由 MatthewSpeaking 于
19:13 编辑
最近尝试用VBA去抓取网页数据，网站是http://ball365.net/newo/mpk.html?ct=1，应该是用xml控件显示出来的，我在vba用WebBrowser打开网页后尝试抓取数据，但是没有成功。之后再用xmlhttp也是无果。现在怀疑是网站结构所导致，请高手们指点一下，谢谢。
[code=vb]Public r As Integer
Sub main()
& & Randomize
& & Dim numberOfpage As Integer
& & Worksheets(&sheet1&).Cells(2, 1).Value = &&
& & Worksheets(&sheet2&).Range(&a3:dv1000&).Value = &&
& & numberOfpage = GetPage()
& & Worksheets(&sheet1&).Cells(2, 1).Value = &Number of pages = & + CStr(numberOfpage)
& & GetRawData (numberOfpage)
Function GetPage() As Integer
& & Dim rawData As String
& & Dim url As String
& & Dim posOfpage As Integer
& & Dim numberOfpage As Integer
& & Dim cParentPage As String
& & cParentPage = &parent.page=& '12
& & url = Worksheets(&sheet1&).Cells(1, 1).Value
& & With CreateObject(&Msxml2.XMLHTTP&)
& && &&&.Open &get&, url, False
& && &&&.send
& && &&&Do Until .ReadyState = 4
& && && && &DoEvents
& && &&&Loop
& && &&&If .Status = 200 Then
& && && && &rawData = .responsetext
& && && && &
& && && && &posOfpage = InStr(rawData, cParentPage)
& && && && &If posOfpage & 0 Then
& && && && && & TempStr = Mid(rawData, posOfpage + 12, InStr(posOfpage, rawData, &;&) - posOfpage - 12)
& && && && && & numberOfpage = CStr(TempStr)
& && && && &End If
& && && && &MsgBox numberOfpage
& && && && && &
& && &&&Else
& && && && &reportErr (.Status)
& && &&&End If
& & End With
& & GetPage = numberOfpage
'& & Open &C:\Personal\4-13.txt& For Output As #1
'& & Print #1, , rawData
'& & Close #1
'& & Shell &notepad C:\Personal\4-13.txt&, vbNormalFocus
End Function
Sub test()
GetRawData (1)
Function GetRawData(ByVal numberOfpage As Integer)
& & Dim page As Integer
& & Dim totalAmount As Integer
& & Dim url As String
& & Dim url1 As String
& & Dim url2 As String
& & Dim matchInfo() As String
& & Dim cPageAmount As String, cRunningBall As String
& & cPageAmount = &parent.matchcount=& '18
& & cRunningBall = &&font color=red&Running Ball&/font&&
& & url2 = &p=&
& & url = Worksheets(&sheet1&).Cells(1, 1)
& & url1 = Left(url, InStr(url, url2) + 1)
& & url3 = &&name=&r=& + CStr(Int((99999 - 10000 + 1) * Rnd + 10000))
& & For page = 1 To numberOfpage
& && &&&url = url1 + CStr(page) + url3
& && &&&MsgBox url
& && &&&With CreateObject(&Msxml2.XMLHTTP&)
& && &&&.Open &get&, url, False
& && &&&.send
'& && &&&Do Until .ReadyState = 4
'& && && && &DoEvents
'& && &&&Loop
& && &&&If .Status = 200 Then
& && && && &rawData = .responsetext
& && && && &posOfamount = InStr(rawData, cPageAmount)
& && && && &If posOfamount & 0 Then
& && && && &
& && && && && & TempStr = Mid(rawData, posOfamount + 18, InStr(posOfamount, rawData, &;&) - posOfamount - 18)
& && && && && & totalAmount = CStr(TempStr)
& && && && && & MsgBox totalAmount
& && && && && &
& && && && && & For i = 0 To totalAmount - 1
& && && && && && &&&
& && && && && && &&&gameft = &parent.A[& + CStr(i) + &]&
& && && && && && &&&tmpPos = InStr(rawData, gameft)
& && && && && && &&&strPos = InStr(tmpPos, rawData, &'&)
& && && && && && &&&endPos = InStr(tmpPos, rawData, &);&)
& && && && && && &&&Match = Mid(rawData, strPos, endPos - strPos)
& && && && && && &&&Match = Replace(Match, &'&, &&)
& && && && && && &&&matchInfo() = Split(Match, &,&)
& && && && && && &&&
& && && && && && &&&'[a1].Resize(1, .End(1).Column).Value
& && && && && && &&&
& && && && && && &&&'Worksheets(&sheet2&).Range(&A1:z1&) = Application.Transpose(matchInfo)
& && && && && && &&&For j = 1 To UBound(matchInfo)
'& && && && && && && && &Worksheets(&sheet2&).Cells(i + 3, 1).Value = matchInfo(1)
'& && && && && && && && &Worksheets(&sheet2&).Cells(i + 3, 2).Value = matchInfo(2)
'& && && && && && && && &Worksheets(&sheet2&).Cells(i + 3, 3).Value = matchInfo(5)
'& && && && && && && && &Worksheets(&sheet2&).Cells(i + 3, 4).Value = matchInfo(6)
'& && && && && && && && &Worksheets(&sheet2&).Cells(i + 3, 5).Value = matchInfo(7)
'& && && && && && && && &Worksheets(&sheet2&).Cells(i + 3, 6).Value = matchInfo(8)
'& && && && && && && && &Worksheets(&sheet2&).Cells(i + 3, 7).Value = matchInfo(9)
'& && && && && && && && &Worksheets(&sheet2&).Cells(i + 3, 8).Value = matchInfo(10)
'& && && && && && && && &Worksheets(&sheet2&).Cells(i + 3, 9).Value = matchInfo(11)
'& && && && && && && && &Worksheets(&sheet2&).Cells(i + 3, 10).Value = matchInfo(12)
'& && && && && && && && &Worksheets(&sheet2&).Cells(i + 3, 11).Value = matchInfo(13)
'& && && && && && && && &Worksheets(&sheet2&).Cells(i + 3, 12).Value = matchInfo(14)
& && && && && && && && & Worksheets(&sheet2&).Cells(r + 3, j).Value = matchInfo(j - 1)
& && && && && && &&&Next j
& && && && && && &
& && && && && && &&&r = r + 1
& && && && && & Next i
& && && && && &
& && && && &End If
& && &&&Else
& && && && &reportErr (.Status)
& && &&&End If
& & End With
& & Next page
End Function
Function reportErr(lStatus As Integer)
& && &&&Select Case lStatus
& && && && &Case 400
& && && && && & MsgBox &Bad Request&, vbCritical, &&A&½&O&í&Ió&
& && && && &Case 401
& && && && && & MsgBox &Unauthorized&, vbCritical, &&A&½&O&í&Ió&
& && && && &Case 402
& && && && && & MsgBox &Payment Required&, vbCritical, &&A&½&O&í&Ió&
& && && && &Case 403
& && && && && & MsgBox &Forbidden&, vbCritical, &&A&½&O&í&Ió&
& && && && &Case 404
& && && && && & MsgBox &Not Found&, vbCritical, &&A&½&O&í&Ió&
& && && && &Case 407
& && && && &&&MsgBox &Proxy Authentication Required&, vbCritical, &&A&½&O&í&Ió&
& && && && &Case 408
& && && && && & MsgBox &Request Timeout&, vbCritical, &&A&½&O&í&Ió&
& && && && &Case 503
& && && && && & MsgBox &Service Unavailable&, vbCritical, &&A&½&O&í&Ió&
& && && && &Case Else
& && && && &&&MsgBox &Can not reach by other reason&, vbCritical, &&A&½&O&í&Ió&
& && &&&End Select
End Function
阅读权限90
在线时间 小时
只要你看得到的WEBBRROWSER都能抓到。
Option Explicit
Sub a()
Dim ie1 As Object, dmt As Object, r As Object, i As Long, j As Long
'Load UserForm1
'UserForm1.Show 0
[a1].CurrentRegion.Clear
Cells.NumberFormat = &@&
Set ie1 = UserForm1.WebBrowser1
With ie1
&&.Navigate &http://ball365.net/newo/mpk.html?ct=1& '网址
&&Do Until .ReadyState = 4
& & DoEvents
&&Loop
&&Set dmt = .Document
End With
Application.ScreenUpdating = False
Set r = dmt.All.tags(&table&)(35).Rows
For i = 0 To r.Length - 1
& &For j = 0 To r(i).Cells.Length - 1
& && &&&Cells(i + 1, j + 1) = r(i).Cells(j).innerText
& &Next
Next
Application.ScreenUpdating = True
Set ie1 = Nothing
Set dmt = Nothing
Set r = Nothing
[a1].CurrentRegion.Columns.AutoFit
End Sub
复制代码
23:48 上传
点击文件名下载附件
20.09 KB, 下载次数: 1856
XM的网页提数越来越牛B了，哈哈&
阅读权限10
在线时间 小时
强人啊{:soso_e179:}
非常感谢，学习学习
阅读权限100
在线时间 小时
不错& && && && && && && && &
阅读权限30
在线时间 小时
& & & & & & & &
留个脚印，以备将来之需^_^
阅读权限50
在线时间 小时
二楼能否把代码稍微解释一下
阅读权限30
在线时间 小时
& & & & & & & &
学习学习！！！！
阅读权限20
在线时间 小时
用2楼代码 抓取http://www.plxtech.com/products/expresslane/partlisting 网页中数据时出现 【运行时错误'91'】
阅读权限20
在线时间 小时
要认真学习一下，
我用IE打开的网页又，如何抓取数据呢？
由于是内网需要账号才能进去，我用我已实际了自动登录，并能打开网页，但面对 已打开的网页，我不知如何抓取数据。
如果用XMHTTP，就会每次抓取回来的数据可以发现，是登录网页，即表明系统不认可此方式的登录。注：我有在OPEN中指写的账号密码。
阅读权限30
在线时间 小时
& & & & & & & &
好好学习，天天向上。
最新热点 /1
ExcelHome每周都有线上直播公开课，
国内一流讲师真身分享，高手贴身答疑，
赶不上直播还能看录像，
关键居然是免费的！
厚木哥们都已经这么努力了，
你还好意思说学不好Office。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师44被浏览13,267分享邀请回答72 条评论分享收藏感谢收起d.shop123.io/tongyong/caijiqi.zip?hmsr=%E7%9F%A5%E4%B9%8E&hmpl=%E7%9F%A5%E4%B9%8E&hmcu=%E7%9F%A5%E4%B9%8E&hmkw=%E7%9F%A5%E4%B9%8E&hmci=%E7%9F%A5%E4%B9%8E31 条评论分享收藏感谢收起写回答查看: 175|回复: 3
用VBA抓取网页内的数据
阅读权限10
在线时间 小时
& & & & & & & &
各位大神，我想通过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
阅读权限90
在线时间 小时
试试：
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复制代码
阅读权限90
在线时间 小时
(33.33 KB, 下载次数: 13)
22:31 上传
点击文件名下载附件
阅读权限10
在线时间 小时
感谢前辈，谢谢！！！
最新热点 /1
ExcelHome每周都有线上直播公开课，
国内一流讲师真身分享，高手贴身答疑，
赶不上直播还能看录像，
关键居然是免费的！
厚木哥们都已经这么努力了，
你还好意思说学不好Office。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师查看: 20154|回复: 17
VBA提取网页数据(4种方法)
阅读权限70
在线时间 小时
& & & & & & & &
1.&&XMLHTTP对象，速度不错，受网页源代码改变影响，但是处理网页源文件最方便自由。
2. InternetExplorer对象，速度一般，受网页源代码改变影响，还需要激活IE，不喜欢。
3. QueryTables对象，平均速度最快，而且基本不受网页源代码改变影响，就是想获取多页数据的时候麻烦，而且多了一个web查询区域需要删除。
4. WebBrowser对象，第一次速度次于XMLHTTP，之后就很快，受网页源代码改变影响，原理同InternetExplorer，就是多了个控件在工作表上不好看，只能靠缩小控件来隐藏。
4种方法各有优劣，看实际情况来选取合适的方法了。
个人觉得网页提取数据，没有什么技巧可言，归根到底，原理基本都是提取网页的源代码然后进行分析处理。
在VBA里，可能用字符串处理的办法更容易理解，其实也可以用获取网页元素的办法，例如第2和第4种方法，就用了一些这样的技巧，但由于对网页的元素不太熟悉，因此如果要方便的方法，还需要多了解网页的结构和代码才行了。
PS：记得看我家耗子写的火狐浏览器脚本，似乎也只能用枚举办法列出不同网页其源码的共同地方来写，想100%通用似乎很难啊。
阅读权限70
在线时间 小时
学习原理，想办法入门
阅读权限70
在线时间 小时
本帖最后由 kangatang 于
17:44 编辑
谢谢整理。
XMLHTTP的速度最快，而且他不需要等待加载和运行脚本。所以我比较喜欢。
特别是XMLHTTP+正则还是有点搞头的。
但是他的header比较难做。只是一知半解。
所以各种方法，哪种方便就用哪种。
阅读权限50
在线时间 小时
学习原理，想入门
阅读权限70
在线时间 小时
& & & & & & & &
本帖最后由 引子玄 于
18:44 编辑
kangatang 发表于
谢谢整理。
XMLHTTP的速度最快，而且他不需要等待加载和运行脚本。所以我比较喜欢。
特别是XMLHTTP+正则还 ...
你都会搞网页数据抓取了,羡慕,我至今还在门外发愣着,就好象起初学VBA一样的状态,在门外徘徊了很久一样
阅读权限95
在线时间 小时
& & & & & & & &
这个好像有了．．．．．．．
阅读权限70
在线时间 小时
jiminyanyan 发表于
这个好像有了．．．．．．．
请补充~~~想细听
阅读权限10
在线时间 小时
要有实例就好了
阅读权限50
在线时间 小时
InternetExplorer对象
灵活，易于控制，比如说：我要定位到楼上的“要有实例就好了”
我们就可以用下面的代码来实现：
Sub ExcelVBA程序开发_Excel_Home论坛()
& & On Error Resume Next
& & With CreateObject(&internetexplorer.application&)
& && &&&.Visible = True
& && &&&.Navigate &http://club.excelhome.net/thread--2.html&
& && &&&Do Until .ReadyState = 4
& && && && &DoEvents
& && &&&Loop
& && &&&.Document.all.tags(&table&)(21).ScrollIntoView& & '定位到第21个table元素（table标签）位置
& & End With
阅读权限50
在线时间 小时
& & & & & & & &
好不好，不存在于外部，而是存在于我们的内心的，从来没有天生的好和坏，只是我们的认识是否到位。
数控机床加工出来的东西，很好。可是呢，手工做的更有价值。这就要看你的取舍了。
最新热点 /1
ExcelHome每周都有线上直播公开课，
国内一流讲师真身分享，高手贴身答疑，
赶不上直播还能看录像，
关键居然是免费的！
厚木哥们都已经这么努力了，
你还好意思说学不好Office。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师查看: 8424|回复: 10
请问如何抓取网页中指定的数据？？
阅读权限20
在线时间 小时
如题，需要抓取的网页为：http://219.136.222.219/t03qy/t09qyzlck/list_zyjsry.jsp?dwbh=10136
现在我想抓取该网页中“状态”为“锁定”的人员信息（包括：人员编号、姓名、性别、状态四样数据），并将这些数据赋值于一个二维数组arr。
请问VBA的代码应该怎么写？
有知道的高手，劳烦帮小弟写一个，谢谢！
在线时间 小时
头像被屏蔽
提示: 作者被禁止或删除 内容自动屏蔽
阅读权限20
在线时间 小时
谢谢，先去试试
阅读权限20
在线时间 小时
情况如何？
阅读权限20
在线时间 小时
zyxdyx 发表于
情况如何？
可以抓取，但是整页抓取，没法做到特定条件抓取
阅读权限20
在线时间 小时
本帖最后由 闪存不足 于
12:39 编辑
改了一下, 不知道对不对..
& & Dim arr()
& & Dim ie
& & Set ie = CreateObject(&internetexplorer.application&)
& & bb = Sheet1.Range(&b65536&).End(xlUp).Row
& & ie.Visible = True
& && &&&With ie
& && && && &.Navigate &http://219.136.222.219/t03qy/t09qyzlck/list_zyjsry.jsp?dwbh=10136&
& && && && &Do Until .ReadyState = 4
& && && && && & DoEvents
& && && && &Loop
& && && && &While ie.ReadyState && 4 Or ie.Busy
& && && && && & DoEvents
& && && && &Wend
& && && && &Set dmt = .Document
& && &&&End With
& &&&& &Set r = dmt.All.tags(&table&)(7).Rows
& && &&&For i = 1 To r.Length - 1
& && && && &If InStr(r(i).Cells(4).innertext, &锁定&) & 0 Then
& && && && && &k = k + 1
& && && && && &For j = 1 To r(i).Cells.Length - 2
& && && && && && && & Sheet1.Cells(k, j + 1) = r(i).Cells(j).innertext
& && && && && &Next j
& && && && &End If
& && &&&Next i
& && &&&bb = Sheet1.Range(&b1048576&).End(xlUp).Row
& && &&&arr = Sheet1.Range(&b2:e& & bb)
& & MsgBox &ok&
阅读权限20
在线时间 小时
& & & & & & & &
& &a = 1
& &For i = 2 To UBound(arr_tbdw)
& && & With xmlhttp
& && && && &.Open &get&, &http://219.136.222.219/t03qy/t09qyzlck/list_zyjsry.jsp?dwbh=& & arr_tbdw(i, 1), False
& && && && &.send
& && && && &rs = 0
& && && && &For m = 1 To Len(.responseText)
& && && && && & If InStr(m, .responseText, &锁定&) && 0 Then
& && && && && && & m = InStr(m, .responseText, &锁定&)
& && && && && && & rs = rs + 1
& && && && && & End If
& && && && &Next m
& && && && &rs_qy = 0
& && && && &For m = 1 To Len(.responseText)
& && && && && & If InStr(m, .responseText, &&查看&/a&&) && 0 Then
& && && && && && & m = InStr(m, .responseText, &&查看&/a&&)
& && && && && && & rs_qy = rs_qy + 1
& && && && && & End If
& && && && &Next m
& && && && &ReDim Preserve arr_ryxx1(1 To 10, 1 To (rs - 1 + a))
& && && && &For m = 1 To rs_qy
& && && && && &If InStr(Application.Clean(Trim(Split(Split(.responseText, &&操作&/td&&)(1), &&查看&/a&&)(m - 1))), &锁定&) & 0 Then
& && && && && && &arr_ryxx1(1, a) = arr_tbdw(i, 1)
& && && && && && &arr_ryxx1(2, a) = arr_tbdw(i, 2)
& && && && && && &arr_ryxx1(3, a) = Application.Clean(Trim(Split(Split(Split(Split(.responseText, &&操作&/td&&)(1), &&查看&/a&&)(m - 1), &&td&&&)(2), &&/td&&)(0)))'编码
& && && && && && &arr_ryxx1(4, a) = Application.Clean(Trim(Split(Split(Split(Split(.responseText, &&操作&/td&&)(1), &&查看&/a&&)(m - 1), &&td&&&)(3), &&/td&&)(0))) '姓名
& && && && && && &arr_ryxx1(6, a) = Replace(Application.Clean(Trim(Split(Split(Split(Split(.responseText, &&操作&/td&&)(1), &&查看&/a&&)(m - 1), &&td&&&)(5), &&/td&&)(0))), Chr(32), &&) '状态
& && && && && && &a = a + 1
& && && && && &End If
& && && && &Next m
& && & End With复制代码用这段代码可以实现
阅读权限20
在线时间 小时
a814153 发表于
& & Dim arr()
& & Dim ie
经验证，能提取该网页数据，因为我比较菜，想学提取数据知识，代楼主向您提问：
&&1、提取时能不能不让该网页在浏览器中跳出来！？
&&2、提取的数据，没有按楼主要求的状态为“锁定”项进行二次筛选列出
&&3、只提取一页的数据，能不能按http://219.136.222.219/t03qy/t09qyzlck/list_zyjsry.jsp?dwbh=10136中的后面10136数字，依次向前或向后推，提取多页面的数据？！
阅读权限20
在线时间 小时
等待解答中......
阅读权限90
在线时间 小时
& & & & & & & &
zyxdyx 发表于
经验证，能提取该网页数据，因为我比较菜，想学提取数据知识，代楼主向您提问：
&&1、提取时能不能不让该 ...
7楼的不就是不弹出的。
把10136做变量，循环一下不就可以提取多页数据了。
最新热点 /1
ExcelHome每周都有线上直播公开课，
国内一流讲师真身分享，高手贴身答疑，
赶不上直播还能看录像，
关键居然是免费的！
厚木哥们都已经这么努力了，
你还好意思说学不好Office。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师