百度地图搜索结果导出方法大全，批量采集公司信息Excel操作及TXT导出工具分享

2016-05-17 作者：光的传人 分类：资源分享 评论人数6人 阅读

昨天朋友问我：“如何将百度地图的搜索结果导出来?”这貌似是一个非常实用的工作，因为百度地图中包含了大量的公司信息（公司名、公司地址、公司电话等等），如果一个地方一个地方搜索的话，那非常的费时费力。但是如何才能将百度地图中搜索关键词的结果全部导出来呢？本想着网上人才济济，这样的工具或软件、方法早就应该有吧！没想到搜索了一下午的资料，竟然收获寥寥，有几张别人截图看着很厉害的工具也只是推广，还要加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 = "?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文本。

Tags：

转载请标注：SEO三人行——百度地图搜索结果导出方法大全，批量采集公司