设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

12下一页
返回列表 发新帖
查看: 6271|回复: 10
打印 上一主题 下一主题

[模块/函数] 【抛砖引玉】在Access中使用地图

[复制链接]
跳转到指定楼层
1#
发表于 2016-11-10 09:23:11 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
本帖最后由 fan0217 于 2016-11-10 18:30 编辑

这里使用的是腾讯地图。可前往http://map.qq.com/申请开发Key



关键代码:
  1. ''' <summary>
  2.     ''' 根据经纬度获取地址
  3.     ''' </summary>
  4.     ''' <param name="latitude">纬度</param>
  5.     ''' <param name="longitude">经度</param>
  6.     ''' <param name="tengXunMapKey">腾讯地图开发Key,申请地址http://lbs.qq.com/ </param>
  7.     ''' <returns></returns>
  8.     ''' <remarks></remarks>
  9. Function GetAddress(latitude As Double, longitude As Double, tengXunMapKey As String)
  10.         Dim apiuri As String
  11.         apiuri = "http://apis.map.qq.com/ws/geocoder/v1/?location=" & latitude & "," & longitude & "&key=" & tengXunMapKey
  12.         Dim retJson As String
  13.         retJson = HttpGet(apiuri)
  14.         GetAddress = retJson
  15. End Function

  16. Function HttpGet(url As String) As String
  17.      Dim xmlHttp As Object
  18.      Set xmlHttp = CreateObject("Msxml2.XMLHTTP.3.0")
  19.      If Not IsObject(xmlHttp) Then
  20.          Set xmlHttp = CreateObject("Msxml2.XMLHTTP.3.0")
  21.          If Not IsObject(xmlHttp) Then Exit Function
  22.      End If
  23.      xmlHttp.Open "GET", url, False
  24.      xmlHttp.setRequestHeader "CONTENT-TYPE", "application/json;charset=UTF-8"
  25.      xmlHttp.send

  26.      Do While xmlHttp.ReadyState <> 4
  27.          DoEvents
  28.      Loop
  29.   
  30.         Dim ret As String
  31.          ret = xmlHttp.responseText
  32.        HttpGet = ret
  33. End Function
复制代码


测试:
  1. Sub Test()
  2.     Debug.Print GetAddress(31.45, 105.75, "O24BZ-GW5RD-V5T4O-HOHGD-MEDWT-DTFB4")
  3. End Sub
复制代码


输出结果:json格式,自己想办法解析了。

  1. {
  2.     "status": 0,
  3.     "message": "query ok",
  4.     "request_id": "6202287292262931140",
  5.     "result": {
  6.         "location": {
  7.             "lat": 31.45,
  8.             "lng": 105.75
  9.         },
  10.         "address": "四川省南充市南部县大升路",
  11.         "formatted_addresses": {
  12.             "recommend": "南部县永红乡观音场(大升路西)",
  13.             "rough": "南部县永红乡观音场(大升路西)"
  14.         },
  15.         "address_component": {
  16.             "nation": "中国",
  17.             "province": "四川省",
  18.             "city": "南充市",
  19.             "district": "南部县",
  20.             "street": "大升路",
  21.             "street_number": ""
  22.         },
  23.         "ad_info": {
  24.             "adcode": "511321",
  25.             "name": "中国,四川省,南充市,南部县",
  26.             "location": {
  27.                 "lat": 31.450001,
  28.                 "lng": 105.75
  29.             },
  30.             "nation": "中国",
  31.             "province": "四川省",
  32.             "city": "南充市",
  33.             "district": "南部县"
  34.         },
  35.         "address_reference": {
  36.             "village": {
  37.                 "title": "千佛观村",
  38.                 "location": {
  39.                     "lat": 31.44953,
  40.                     "lng": 105.745461
  41.                 },
  42.                 "_distance": 434.3,
  43.                 "_dir_desc": "东"
  44.             },
  45.             "town": {
  46.                 "title": "永红乡",
  47.                 "location": {
  48.                     "lat": 31.450001,
  49.                     "lng": 105.75
  50.                 },
  51.                 "_distance": 0,
  52.                 "_dir_desc": "内"
  53.             },
  54.             "street": {
  55.                 "title": "大升路",
  56.                 "location": {
  57.                     "lat": 31.449713,
  58.                     "lng": 105.751801
  59.                 },
  60.                 "_distance": 167.9,
  61.                 "_dir_desc": "西"
  62.             }
  63.         }
  64.     }
  65. }
复制代码




本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅

点击这里给我发消息

2#
发表于 2016-11-10 09:33:33 | 只看该作者
顶一个,这个真不错。谢谢分享
几年前我用Google的地图做过一个,可惜后来Google退了中国,一直无法使用了。我也来换换你这个试试,另有否百度的?

http://www.office-cn.net/thread-93113-1-1.html


点击这里给我发消息

3#
发表于 2016-11-10 10:26:52 | 只看该作者
牛!扩展了Access的应用
4#
发表于 2016-11-10 17:10:16 | 只看该作者
楼主威武!!
回复

使用道具 举报

5#
发表于 2016-11-10 17:26:09 | 只看该作者
楼主厉害
回复

使用道具 举报

6#
发表于 2016-11-10 18:35:51 | 只看该作者
这个值得拥用,赞
7#
发表于 2016-11-11 01:30:50 | 只看该作者
百度也有。之前申请了key,一直没时间弄。光API就一百多页了。
只是地理位置还不够的,加上导航路线或者公交车换乘就腻害了。
8#
 楼主| 发表于 2016-11-11 11:48:44 | 只看该作者
roych 发表于 2016-11-11 01:30
百度也有。之前申请了key,一直没时间弄。光API就一百多页了。
只是地理位置还不够的,加上导航路线或者公 ...

抛砖引玉
9#
发表于 2016-11-11 14:42:59 | 只看该作者
谢谢分享
新手,期待斑竹下次抛玉引砖
10#
发表于 2016-11-14 10:58:13 | 只看该作者
期待完整版呀/se
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-1 17:26 , Processed in 0.090190 second(s), 34 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表