VBA网抓教程.docx
- 文档编号：25996306
- 上传时间：2023-06-17
- 格式：DOCX
- 页数：32
- 大小：25.32KB
VBA网抓教程.docx
《VBA网抓教程.docx》由会员分享，可在线阅读，更多相关《VBA网抓教程.docx（32页珍藏版）》请在冰豆网上搜索。
VBA网抓教程
vba网抓常用方法：
1、xmlhttp/winhttp法：
用xmlhttp/winhttp模拟向服务器发送请求，接收服务器返回的数据。
优点：
效率高，基本无兼容性问题。
缺点：
需要借助如fiddler的工具来模拟http请求。
2、IE/webbrowser法：
创建IE控件或webbrowser控件，结合htmlfile对象的方法和属性，模拟浏览器操作，获取浏览器页面的数据。
优点：
这个方法可以模拟大部分的浏览器操作。
所见即所得，浏览器能看到的数据就能用代码获取。
缺点：
各种弹窗相当烦人，兼容性也确实是个很伤脑筋的问题。
上传文件在IE里根本无法实现。
（有实现方法？
请一定告诉我）
3、QueryTables法：
因为它是excel自带，所以勉强也算是一种方法。
其实此法和xmlhttp类似，也是GET或POST方式发送请求，然后得到服务器的response返回到单元格内。
优点：
excel自带，可以通过录制宏得到代码，处理table很方便。
代码简短，适合快速获取一些存在于源代码的table里的数据。
缺点：
无法模拟referer等发包头（如果你有在QT中模拟referer的方法，请一定告诉我）
SubMain（）
DimstrTextAsString
WithCreateObject（"MSXML2.XMLHTTP"）'CreateObject（"WinHttp.WinHttpRequest.5.1"）'
.Open"POST","",False
.setRequestHeader"Content-Type","application/x-www-form-urlencoded"
.setRequestHeader"Referer",""
.Send
strText=.responsetext
Debug.PrintstrText
EndWith
EndSub
拷贝剪切板:
SubCopyToClipbox（strTextAsString）
'文本拷贝到剪贴板
WithCreateObject（"new:
{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"）
.SetTextstrText
.PutInClipboard
EndWith
EndSub
DongYu作业1.rar
（18.29KB,下载次数:
88）
2014-10-2117:
05上传
下载次数:
88
SubHomerWork1_1（）
'新手:
DongYu
'作业：
1、网站：
'操作：
点击“今日在售产品”，获取今日在售产品第一页的数据。
DimxmlAsNewMSXML2.XMLHTTP,urlAsString,StAsString
Dimarr,brr,ar,i,c
url="
Withxml
.Open"GET",url,False
.send
St=.responseText
EndWith
St=Split（Split（St,"
（1）,"
arr=Split（St,"
ReDimbrr（1ToUBound（arr）,1To9）
Fori=1ToUBound（arr）
ar=arr（i）
brr（i,1）=Split（Split（ar,"value='"）
（1）,"'"）（0）+Split（Split（ar,"
（1）,""）（0）
brr（i,2）=Split（Split（ar,"
（1）,""）（0）
brr（i,3）=Split（Split（ar,"
（1）,""）（0）
brr（i,4）=Split（Split（ar,"
（1）,""）（0）
brr（i,5）=Split（Split（ar,"
（2）,""）（0）
brr（i,6）=Split（Split（ar,"
brr（i,7）=Split（Split（ar,"
brr（i,8）=Split（Split（ar,"
brr（i,9）=Split（Split（Split（ar,"
（1）,">"）
（1）
Nexti
WithActiveSheet
.Cells.Clear
.Columns（"D:
E"）.NumberFormatLocal="yyyy-m-d"
.[a1].Resize（1,10）=[{"对比","产品名称","银行","起售日","停售日","币种","管理期（月）","产品类型","预期收益（%）","收益"}]
.[b2].Resize（UBound（brr,1）,9）=brr
EndWith
EndSub
Sub按钮2_单击（）
Dimurl,html
url="
url=url&"&OC=PEK"'北京首都机场
url=url&"&DC=SHA"'上海虹口机场
url=url&"&dstDesp=GUANGZHOU%B9%E3%D6%DD"
url=url&"&dst2=CAN"
url=url&"&DD=2014-10-22"'查询日期
url=url&"&DT=7"
url=url&"&BD="
url=url&"&BT=7"
url=url&"&AL=ALL"'全部航空
url=url&"&DR=true"
url=url&"&image.x=33"
url=url&"&image.y=9"
url=url&"&Sn=87bf24142bc0c78727610871f373e0a7"
Sethtml=CreateObject（"htmlfile"）
WithCreateObject（"msxml2.xmlhttp"）
.Open"get",url,False
.send
html.body.innerhtml=.responsetext
Settb=html.all.tags（"div"）
Fori=0Totb.Length-1
Iftb（i）.classname="menu_layout2"Ortb（i）.classname="listone_layout"Ortb（i）.classname="listtwo_layout"Ortb（i）.classname="menu_content_small2"Then
n=n+1
Forj=0Totb（i）.childnodes.Length-1
Cells（n,j+1）=tb（i）.childnodes（j）.innertext
Next
EndIf
Next
EndWith
EndSub
Sub作业1_2_获取航班信息数据（）
'网站：
'操作：
点击“查询”，获取航班信息数据。
DimStAsString,Url$,arr,brr,Crr
DimS1$,S2$,i%,j%,rngAsRange
Url="
WithCreateObject（"WinHttp.WinHttpRequest.5.1"）
.Open"GET",Url,False
.Send
St=.responsetext
EndWith
'
IfInStr（St,"
Cells（1,1）="抱歉！
没有满足条件的航班，请重新输入查询条件！
"
Else
St=Split（Split（St,"
（1）,"
"）（0）
WithActiveSheet
Cells（1,1）=Split（Split（St,""）
（1）,""）（0）
arr=Split（St,"
Fori=1ToUBound（arr）
S1=arr（i）
Crr=Split（S1,"
ReDimbrr（1ToUBound（Crr）+2,1To5）'班次UBound（S1）+1，航空公司及机行+1，航线+1
'航空公司
brr（1,1）=Trim（Split（Split（S1,"
（1）,"
brr（1,2）=Trim（Split（Split（S1,"
（1）,"
brr（1,2）=Trim（Split（Split（brr（1,2）,"font"">"）
（1）,""）（0））
brr（1,3）=Trim（Split（Split（S1,"
（2）,"
《爱和自由》读书心得15篇.docx
