在一个excel里面直接批量从谷歌地图抓取经纬度（vba部分）

'http://apps.hi.baidu.com/share/detail/6440301

Function Uri(strText As String)
'Sub Uri()
Dim s As Integer
Dim ii As String
Dim tmp As String

'strText = "你1 你"
'uri = ""

For i = 1 To Len(strText)
temp = Asc(Mid$(strText, i, 1))
If temp > 255 Or temp < 0 Then
tmp = Hex(temp)
Uri = Uri & "%" & Left(tmp, 2) & "%" & Right(tmp, 2)
Else
Uri = Uri & Mid$(strText, i, 1)
End If
Next i
Uri = Replace(Uri, " ", "%20")
End Function
Function toUTF8(szInput)
Dim wch, uch, szRet
Dim x
Dim nAsc, nAsc2, nAsc3
'如果输入参数为空，则退出函数
If szInput = "" Then
toUTF8 = szInput
Exit Function
End If
'开始转换
For x = 1 To Len(szInput)
'利用mid函数分拆GB编码文字
wch = Mid(szInput, x, 1)
'利用ascW函数返回每一个GB编码文字的Unicode字符代码
'注：asc函数返回的是ANSI 字符代码，注意区别
nAsc = AscW(wch)
If nAsc < 0 Then nAsc = nAsc + 65536

If (nAsc And &HFF80) = 0 Then
szRet = szRet & wch
Else
If (nAsc And &HF000) = 0 Then
uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
szRet = szRet & uch
Else
'GB编码文字的Unicode字符代码在0800 - FFFF之间采用三字节模版
uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _
Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _
Hex(nAsc And &H3F Or &H80)
szRet = szRet & uch
End If
End If
Next

toUTF8 = szRet
End Function
Sub Macro2()
'
' Macro2 Macro
'
' 快捷键: Ctrl+t
'
Dim iRows, iRowBeg As Integer
Dim strCxt As String
Dim strHtml As String
Dim strSearch As String
Dim strUri As String
Dim HttpReq As Object
Dim strRes As String
Dim iReDown, iHasReDown As Integer
Dim strSrcCol, strResCol As String

iReDown = 5 '如果下载失败重复尝试的次数
iHasReDown = 0 '已经重复下载了的次数
iRowBeg = 1 '要下载的开始行
iRows = 100 '要下载的截止行
strSrcCol = "A" '从哪一列读取数据
strResCol = "D" '在哪一列存储结果

Set HttpReq = CreateObject("MSXML2.XMLHTTP.3.0")
For counter = 1 To iRows
Debug.Print counter & "/" & iRows
Sheet1.Select
strSearch = Range(strSrcCol & counter) & " 北京"
strSearch = toUTF8(strSearch)
strSearch = Uri(strSearch)
strHtml = "http://maps.google.cn/maps/geo?q=" & strSearch & "&output=csv&oe=utf8&sensor=true_or_false&key=ABQIAAAAqaGKijD7euSpqDeVsNA85xTT3OL8VXjPlPTFW7n7OgOFwXoSnxT7IP1pHznaiGwWMvsEq_SkxvESLw"
'strHtml = "http://maps.google.com.hk/maps/geo?q=014%E4%B8%AD%E5%BF%83%20%E6%B4%9B%E9%98%B3%E5%B8%82&output=csv&oe=utf8&sensor=true_or_false&key=ABQIAAAAqaGKijD7euSpqDeVsNA85xTT3OL8VXjPlPTFW7n7OgOFwXoSnxT7IP1pHznaiGwWMvsEq_SkxvESLw"
'strHtml = "http://maps.google.cn/maps/geo?q=%E4%BA%94%E5%8F%B0%E5%B1%B1%20%E5%8C%97%E4%BA%AC&output=csv&oe=utf8&sensor=true_or_false&key=ABQIAAAAqaGKijD7euSpqDeVsNA85xTT3OL8VXjPlPTFW7n7OgOFwXoSnxT7IP1pHznaiGwWMvsEq_SkxvESLw/"
'strHtml = "http://www.baidu.com"
'Range("E" & counter) = strHtml
HttpReq.Open "GET", strHtml, False
HttpReq.send
'HttpReq.getAllResponseHeaders
'MsgBox HttpReq
strRes = HttpReq.responseText
Range(strResCol & counter) = strRes
If ",0,0" = Right(strRes, 4) Then
'结果错误
If iHasReDown >= iReDown - 1 Then
'错误次数超过
iHasReDown = 0
Else
iHasReDown = iHasReDown + 1
counter = counter - 1
End If
Else
iHasReDown = 0
End If
Next
End Sub

在一个excel里面直接批量从谷歌地图抓取经纬度（vba部分）相关推荐

谷歌地图商家抓取工具 G-Business Extractor 7.5
G 业务提取器 | 谷歌地图抓取工具 G-Business Extractor是一款功能强大的工具,可帮助您从 Google 地图中寻找商机.它是最好的Google Maps Scraper工具,能够 ...
如何把Excel坐标加载到谷歌卫星地图上
通过RTK采集到的经纬度坐标点往往需要加载到卫星地图上和图上位置进行一下对比以确定是否准确,水经注万能地图就提供了加载Excel坐标点到地图上的方法,下面将一谷歌地图为例,介绍一下加载Excel坐标点 ...
Android Google Map开发指南(三)百度地图、谷歌地图自如切换
如果你是刚开始接触谷歌地图的话,推荐你先看一下文章: Android Google Map 开发指南(一)解决官方demo显示空白只展示google logo问题 Android Google Map ...
百度与谷歌地图瓦片组织方式对比
百度是从中心点经纬度(0,0)度开始计算瓦片,在第1级时百度将世界地图分为4块. 中心点右上部分(中国地区)占1块. 谷歌是从左上角经纬度(-180,90)度开始计算瓦片,在第1级时谷歌将世界地图分为 ...
谷歌地图api 微信小程序_使用Google的融合位置提供程序API进行实时位置跟踪
谷歌地图api 微信小程序 Location tracking and monitoring have seen a surge in modern application development w ...
谷歌地图JavaScript API第3版地理编码服务
地理编码服务概观地理编码请求地理编码响应地理编码结果地址组件类型状态代码反向地理编码视口偏置区码偏置概观地理编码地址(如"1600剧场百汇,山景,CA")转换 ...
个人永久性免费-Excel催化剂功能第95波-地图数据挖宝之IP地址转地理地址及不同经纬度版本转换...
经过上一波POI兴趣点查询后,地图数据挖宝也接近尾声,这次介绍在数据采集.准备过程中需要用到的一些转换功能,有IP地址转换地理地址及不同地图版本的经纬度转换. 背景知识在电商.网络的数据分析过程中, ...
谷歌地图下载器中“地图艺术照”
最经在网上流传的[8张谷歌地图"谷歌地图艺术照",颠覆艺术界对地球的认知]的确火了一把,是把用谷歌卫星地图截取的图片进行了对称镜像.地图中分别是:中国的三峡大坝:美国明尼苏达州东百 ...
谷歌地球和谷歌地图区别
1.谷歌地球是一款由Google公司开发的的虚拟地球仪软件, 它把卫星图像.地图.百科全书和飞行模拟器整合在一起,布置在一个地球的三维模型上. 2.谷歌地图是Google公司向全球提供的电子地图服务, ...

在一个excel里面直接批量从谷歌地图抓取经纬度（vba部分）

在一个excel里面直接批量从谷歌地图抓取经纬度（vba部分）相关推荐

最新文章

热门文章