百度地图搜索结果导出方法winHTTP vba

2017.01.02

昨天朋友问我：“如何将百度地图的搜索结果导出来?”这貌似是一个非常实用的工作，因为百度地图中包含了大量的公司信息（公司名、公司地址、公司电话等等），如果一个地方一个地方搜索的话，那非常的费时费力。但是如何才能将百度地图中搜索关键词的结果全部导出来呢？本想着网上人才济济，这样的工具或软件、方法早就应该有吧！没想到搜索了一下午的资料，竟然收获寥寥，有几张别人截图看着很厉害的工具也只是推广，还要加QQ或微信，肯定想着收钱的（这类软件尽量不要花钱买），看来将百度地图搜索结果导出确实是个有挑战性的工作！自己动手，丰衣足食，有挑战性，就要来挑战，这才是光的传人的个性！终于，功夫不负有心人，今天在搜索了大量资料并实践后，终于找到一些方法及工具能够顺利的把百度地图的搜索结果导出来了，下面就来分享一下，希望问题得到解决的朋友来本文留言相告！

百度地图搜索结果导出方法一：利用Excel文件中ExcelVBA程序功能进行导出搜索关键词结果。具体方法如下（代码源自excelhome网站，本文详细介绍操作流程）：

1、打开Excel文件（或新建一个Excel文件），在菜单栏中找到“开发工具”→“宏”，创建宏，应该也叫VBA程序（截图以office 2016版本为例，其他版本只要能找到宏添加运行即可）。

2、点击创建，在打开的代码编辑框里，粘贴以下代码：

Sub BaiDuMap()

Dim winhttp, URL, arr, i, j, p, t, objSC, strJSON, objJSON, pages, n, strFunc, jsonItem

Sheet1.Cells.Clear

Set winhttp = CreateObject("WinHttp.WinHttpRequest.5.1")

Application.ScreenUpdating = False

Application.DisplayStatusBar = True

With winhttp

For i =1 To 94

URL = "http://map.baidu.com/?newmap=1&reqflag=pcmap&biz=1&pcevaname=pc2&da_par=baidu&from=webmap&qt=con&from=webmap&c=236&wd=关键词&pn=" & i - 1 & "&db=0&wd2=&sug=0&da_src=pcmappg.poi.page&on_gel=1&src=7&gr=3&l=12&addr=0&nn=" & (i - 1) * 10 & "&tn=B_NORMAL_MAP&ie=utf-8&t=1423980798053"

.Open "GET", URL, False

.setRequestHeader "Connection", "Keep-Alive"

.send

t = UToGB(.responsetext)

strJSON = Split(Split(t, """content"":")(1), ",""current_city")(0)

Set objSC = CreateObject("ScriptControl")

objSC.Language = "JScript"

strFunc = "function getjson(s) { return eval('(' + s + ')'); }"

objSC.AddCode strFunc

Set objJSON = objSC.CodeObject.getjson(strJSON)

For Each jsonItem In objJSON

On Error Resume Next

n = n + 1

Cells(n, 1) = CallByName(jsonItem, "name", VbGet)

Cells(n, 2) = CallByName(jsonItem, "addr", VbGet)

Cells(n, 3) = CallByName(jsonItem, "tel", VbGet)

Next

Next

End With

Set objSC = Nothing

Set objJSON = Nothing

Set jsonItem = Nothing

Set winhttp = Nothing

Application.StatusBar = False

Application.ScreenUpdating = True

End Sub

Function UToGB(ByVal str1 As String)

Dim i, y, arr1(), arr2(), ireg As Object, imch As Object, mch As Object

Set ireg = CreateObject("vbscript.regexp")

ireg.Global = True

ireg.Pattern = "\\u\w{4}"

Set imch = ireg.Execute(str1)

For Each mch In imch

y = y + 1

ReDim Preserve arr1(1 To y)

ReDim Preserve arr2(1 To y)

arr1(y) = ChrW(CLng(Replace(mch.Value, "\u", "&h")))

arr2(y) = mch.Value

Next

For i = 1 To UBound(arr1)

str1 = Replace(str1, arr2(i), arr1(i))

Next

UToGB = str1

Set ireg = Nothing

End Function

3、修改参数，使其能够导出自己需要的结果。第8行，For i = 1 To 94（导出的页数，如果比世纪搜索结果页数多，后面就会重复），第9行URL中，c=236（数字代表城市，具体数字代表的城市详见本文最后，根据自己需要修改），wd=关键词（直接修改关键词即可，经过试验，有部分关键词运行会出错，如果出错，请重新“重新设置”重新运行，如果还出错，就只能看着自己改改代码了，或者去excelhome求助，我是不太熟悉这些代码），一般来说这样就能适合小批量地图搜索结果导出了！

百度地图搜索结果导出方法二：使用小工具直接导出TXT文本。

找了很久，用了很多工具，例如“百度兴趣点下载工具V2.1.exe”，测试后没效果或出错，舍弃，继续寻找……终于找到一个导出百度地图搜索结果能用的、好用的工具！原来的软件名字叫做百度爬虫.zip（容易跟SEO行业中的意思混淆），我就重新命名了一下：百度地图搜索结果导出工具。使用截图如下：

导出搜索结果截图（重要的公司名、地址、电话都有了）：

是不是很给力啊！什么？只想要excel格式的？那么就得自己动手了，我不是工具的开发者，也不会修改，但是人家导出的结果很详细，有了txt文本自然就好办了！搜索“如何将txt文件转换成Excel文件”就能找到具体方法。在这里大体说一下方法：打开excel菜单栏中“数据”→“自文本”，如图所示：

剩下的就很简单了！直接完成就可以将导出的百度搜索结果txt文档转换成excel，然后把不需要的列删除即可！大功告成了！百度地图搜索结果导出工具下载链接:http://pan.baidu.com/s/1nvrOmZR密码: 373f（收藏本站，记得成功来分享心得哦！）

百度地图城市对应数字代码（为空的我也不知道怎么回事，可以参见文章“怎么把百度地图的搜索结果全部导出到Excel文件(通过百度地图采集公司信息--名称、地址、电话）”）：

城市        对应数字