VBA调用OneMap API通过邮编算距离时长报错求助

核心问题分析 #

• API参数完全错误：
  1. 你把API密钥错误赋值给了routeType参数——该参数实际用于指定出行方式（如walk/drive/pt），API密钥应通过token参数传递。
  2. 直接传入邮编作为start/end参数不符合API要求：OneMap路由API的起点/终点必须是经纬度坐标，而非邮编，这是返回Your location provided is not valid.的根本原因。
• 错误处理缺失：当API返回错误响应（含error字段）时，代码仍强行访问route_summary节点，导致「类型不匹配」报错。

修复后的完整代码 #

逻辑说明：先通过地理编码API将邮编转成经纬度，再调用路由API #

' 辅助函数：根据新加坡邮编获取经纬度（返回格式："纬度,经度"）
Function GetCoordinatesFromPostal(postalCode As String, apiKey As String) As String
    Dim xmlHttp As Object
    Dim response As String
    Dim jsonResponse As Object
    
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    ' 调用OneMap地理编码API获取坐标
    xmlHttp.Open "GET", "https://developers.onemap.sg/privateapi/common/search?searchVal=" & postalCode & "&returnGeom=Y&getAddrDetails=N&token=" & apiKey, False
    xmlHttp.Send
    
    response = xmlHttp.ResponseText
    Set jsonResponse = JsonConverter.ParseJson(response)
    
    ' 检查是否返回有效坐标
    If jsonResponse("found") > 0 Then
        GetCoordinatesFromPostal = jsonResponse("results")(1)("Y") & "," & jsonResponse("results")(1)("X")
    Else
        GetCoordinatesFromPostal = ""
    End If
End Function

' 主函数：调用OneMap路由API获取距离和时长
Function OneMapAPI(ByVal originPostal As String, ByVal destinationPostal As String, apiKey As String) As String
    Dim xmlHttp As Object
    Dim response As String
    Dim distance As Double
    Dim duration As Double
    Dim originCoords As String
    Dim destCoords As String
    Dim jsonResponse As Object
    
    ' 先获取起点、终点的经纬度
    originCoords = GetCoordinatesFromPostal(originPostal, apiKey)
    destCoords = GetCoordinatesFromPostal(destinationPostal, apiKey)
    
    ' 校验坐标获取结果
    If originCoords = "" Or destCoords = "" Then
        OneMapAPI = "错误：无法获取有效坐标"
        Exit Function
    End If
    
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    ' 修正路由API参数：token传密钥，routeType指定出行方式（示例用drive）
    xmlHttp.Open "GET", "https://developers.onemap.sg/privateapi/routingsvc/route?start=" & originCoords & "&end=" & destCoords & "&routeType=drive&token=" & apiKey, False
    xmlHttp.Send
    
    response = xmlHttp.ResponseText
    Debug.Print response ' 输出响应便于调试
    
    Set jsonResponse = JsonConverter.ParseJson(response)
    
    ' 先检查API是否返回错误
    If jsonResponse.Exists("error") Then
        OneMapAPI = "API错误：" & jsonResponse("error")
        Exit Function
    End If
    
    ' 解析距离和时长
    On Error Resume Next
    distance = jsonResponse("route_summary")("total_distance") / 1000 ' 转换为公里
    If Err.Number <> 0 Then
        Debug.Print "获取距离时出错：" & Err.Description
        distance = 0
    End If
    
    duration = jsonResponse("route_summary")("total_time") / 3600 ' 转换为小时
    If Err.Number <> 0 Then
        Debug.Print "获取时长时出错：" & Err.Description
        duration = 0
    End If
    On Error GoTo 0
    
    OneMapAPI = "Distance: " & Format(distance, "0.00") & "km, Duration: " & Format(duration, "0.00") & "h"
End Function

' 测试用例
Sub TestOneMapAPI()
    Dim apiKey As String
    Dim result As String
    
    apiKey = "你的API密钥" ' 替换为实际的OneMap API密钥
    result = OneMapAPI("380016", "658713", apiKey)
    
    MsgBox result
End Sub

关键修复点说明 #

1. 参数修正：
   • 新增token参数传递API密钥，routeType设置为合法的出行类型（如drive/walk/pt）。
   • 通过地理编码API将邮编转换为经纬度，满足路由API的参数要求。
2. 错误处理增强：
   • 先校验地理编码是否成功获取坐标，避免无效请求。
   • 路由API响应后优先判断是否存在error字段，避免访问不存在的route_summary节点导致报错。
3. 调试优化：保留Debug.Print response，便于查看API返回内容快速定位问题。

内容的提问来源于stack exchange，提问作者Benedict Ng