用excelVBA实现需登录网站批量信息的提取（紧急）

liucqa

kangatang 发表于 2012-7-12 10:40
侠圣，能否给个例子让我们学习学习

你随便找个网站用ie登录，然后用xmlhttp发一个get，就会看到xmlhttp也登录了

kangatang

因为网址里面有个 “SID=......”，我不确定在楼主电脑上是不是相同或者会不会过时失效
请帮忙调试附件，如果出现"失败"，那就不行。
webknoledge.rar (851 Bytes, 下载次数: 83)

2012-7-13 11:59 上传

点击文件名下载附件

kangatang

登陆，跳转到搜索页的工作已经完成，接下来开始做关键词搜索。提取你要的内容。

PS. 最近比较忙，我相信很多朋友跟我一样，只能白天上班时挤出时间参与EH的事情。尤其是像我们家里有小孩。周末都是奉献给他的。
经常来这里，就是图一个对兴趣的极大满足。我的行业和专业是食品制造，跟VBA无关。

引子玄

抓取可是程序自动化当中的高难技术，非一日之功就可以修成正果的。楼主要看到这层认识，好做出清醒的判断。

min177

kangatang 发表于 2012-7-13 12:37
登陆，跳转到搜索页的工作已经完成，接下来开始做关键词搜索。提取你要的内容。

PS. 最近比较忙，我相信 ...

感谢啊！我先下来试试，幸苦了 谢谢您

min177

kangatang 发表于 2012-7-13 12:37
登陆，跳转到搜索页的工作已经完成，接下来开始做关键词搜索。提取你要的内容。

PS. 最近比较忙，我相信 ...

出现了这个情况 。请帮忙看看

kangatang

基本上已经好了，现在还要吗？
运行前，把附件webofk.txt拷贝到目录D:\kangatang下。(用于POST数据)
然后直接运行vbs文件即可。看到"ok"后。新建txt文件，然后打开、粘贴，另存为.html文件。应该看到第60个记录。
如果加个循环就可以逐条提取。
提取邮件地址用正则
Dim regex, matchs, ss, arr()
Set oDict = CreateObject("Scripting.Dictionary")
Set regex = CreateObject("VBSCRIPT.REGEXP")

regex.Global = True
regex.Pattern = "\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*"
Set matchs = regex.Execute(source_data)
ReDim trimed_arr(matchs.Count - 1)
For i = Lbound(trimed_arr) To Ubound(trimed_arr)
   trimed_arr(i) = matchs.Item(i) & vbCrLf
Next
test.rar (2.29 KB, 下载次数: 56)

2012-7-16 22:47 上传

点击文件名下载附件

kangatang

kangatang 发表于 2012-7-16 15:48
基本上已经好了，现在还要吗？
运行前，把附件webofk.txt拷贝到目录D:\kangatang下。(用于POST数据)
然后 ...

其中一个有效的 sid = 4FEGcgfo6lpjL6bcBGJ

kangatang

帮你搞定了，见附件：请将webofk.txt放到文件夹D:\kangatang下。
download.rar (20.79 KB, 下载次数: 108)

2012-7-17 00:45 上传

点击文件名下载附件

1,刚开始的登陆和打开搜索页面会比较慢，后面的下载会感觉快一点。我只循环了55次，下载更多请增加数字，比如1000
2,必须及时更新SID(时效有几个小时吧，反正今天下午到现在，我一直在用同一个SID)，获得有效SID的方法：
打开https://libproxy.eku.edu/login?qurl=http%3a%2f%2fisiknowledge.com
输入
user: Bridgette_knight8
password: comma14down
跳转到网页后，从网址中查找"sid=......"的字符串（比如黑体部分...search_mode=GeneralSearch&SID=4B99c3EE3C8hGlL@lbe&preferencesSaved=）

kangatang

min177，昨天你在线，为什么给我回复。雷锋可能也是兴趣使然。这样说来我还要谢谢提问者。