|
楼主 |
发表于 2014-11-1 20:26
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Sub 百度北京高校()
- Dim url, js
- [a:c].ClearContents
- br = [{"校名","地址","电话"}]
- Range("a1:c1") = br
- url = ""
- Set js = CreateObject("scriptcontrol")
- js.Language = "jscript"
- For p = 1 To 58
- With CreateObject("msxml2.xmlhttp")
- url = "http://map.baidu.com/?newmap=1"
- url = url & "&reqflag=pcmap"
- url = url & "&biz=1"
- url = url & "&from=webmap"
- url = url & "&qt=s"
- url = url & "&da_src=pcmappg.searchBox.button"
- url = url & "&wd=%E5%A4%A7%E5%AD%A6"
- url = url & "&c=131" '城市代码
- url = url & "&src=0"
- url = url & "&wd2="
- url = url & "&sug=0"
- url = url & "&l=12"
- url = url & "&b=(12925680.96,4809619.72;12990640.96,4842195.72)"
- url = url & "&from=webmap"
- url = url & "&tn=B_NORMAL_MAP"
- url = url & "&nn=" & (p - 1) * 10
- url = url & "&ie=utf-8"
- url = url & "&t=1414824689135"
- .Open "get", url, False
- .send
- js.addcode ("renahu = " & .responsetext)
- slen = js.Eval("renahu.content.length") - 1
- For i = 0 To slen
- n = n + 1
- Cells(n + 1, 1) = js.Eval("renahu.content[" & i & "].name")
- Cells(n + 1, 2) = js.Eval("renahu.content[" & i & "].addr")
- Cells(n + 1, 3) = js.Eval("renahu.content[" & i & "].tel")
- Next
- End With
- Next
- End Sub
复制代码
补充内容 (2014-11-9 14:17):
练习四 |
|