将VBA中Google Maps API替换为OpenRouteServices API的实现问题

关键修改点 #

• API端点替换：将Google的Distance Matrix端点换成ORS的方向API端点（以驾车为例，路径为/v2/directions/driving-car）
• 请求方式与参数调整：ORS要求用POST请求传递JSON格式的坐标（而非Google的GET参数），且API密钥需放在请求头的Authorization字段
• 响应解析逻辑更新：ORS的JSON结构和Google完全不同，需调整距离提取的路径
• 地址转坐标支持：若原代码使用地址字符串而非经纬度，需新增ORS地理编码API的调用逻辑

完整可运行代码 #

Option Explicit

' 计算两点间驾车行程距离（返回单位：米，失败返回-1）
Function GetORS_Distance(startLat As Double, startLng As Double, endLat As Double, endLng As Double, apiKey As String) As Double
    Dim xmlHttp As Object
    Dim responseText As String
    Dim jsonObj As Object
    Dim distance As Double
    
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    Const ORS_DIRECTIONS_URL As String = "https://api.openrouteservice.org/v2/directions/driving-car"
    
    ' 构造POST请求的JSON体（ORS坐标格式：[经度, 纬度]）
    Dim requestBody As String
    requestBody = "{""coordinates"": [[" & startLng & "," & startLat & "], [" & endLng & "," & endLat & "]]}"
    
    On Error GoTo ErrorHandler
    With xmlHttp
        .Open "POST", ORS_DIRECTIONS_URL, False
        .SetRequestHeader "Content-Type", "application/json"
        .SetRequestHeader "Authorization", apiKey
        .Send requestBody
        responseText = .responseText
    End With
    
    ' 解析JSON（需导入VBA-JSON模块处理JSON）
    Set jsonObj = JsonConverter.ParseJson(responseText)
    ' 提取距离值（ORS默认返回米）
    distance = jsonObj("features")(1)("properties")("segments")(1)("distance")
    
    GetORS_Distance = distance
    Exit Function
    
ErrorHandler:
    GetORS_Distance = -1
    MsgBox "请求错误：" & Err.Description & vbCrLf & "响应内容：" & responseText
End Function

' 地址转经纬度（返回数组：(纬度, 经度)，失败返回(-1,-1)）
Function GetORS_Geocode(address As String, apiKey As String) As Variant
    Dim xmlHttp As Object
    Dim responseText As String
    Dim jsonObj As Object
    Dim result As Variant
    
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    Dim geocodeUrl As String
    geocodeUrl = "https://api.openrouteservice.org/geocode/search?text=" & URLEncode(address)
    
    On Error GoTo ErrorHandler
    With xmlHttp
        .Open "GET", geocodeUrl, False
        .SetRequestHeader "Authorization", apiKey
        .Send
        responseText = .responseText
    End With
    
    Set jsonObj = JsonConverter.ParseJson(responseText)
    If jsonObj("features").Count > 0 Then
        ' ORS地理编码返回的坐标是[经度, 纬度]，转换为常用的纬度在前格式
        result = Array(jsonObj("features")(1)("geometry")("coordinates")(2), jsonObj("features")(1)("geometry")("coordinates")(1))
    Else
        result = Array(-1, -1)
    End If
    
    GetORS_Geocode = result
    Exit Function
    
ErrorHandler:
    GetORS_Geocode = Array(-1, -1)
    MsgBox "地理编码错误：" & Err.Description & vbCrLf & "响应内容：" & responseText
End Function

' URL编码辅助函数，处理地址中的特殊字符
Function URLEncode(str As String) As String
    Dim bytes() As Byte
    bytes = StrConv(str, vbUnicode)
    Dim i As Integer
    Dim char As Integer
    Dim output As String
    
    For i = 0 To UBound(bytes) Step 2
        char = bytes(i)
        Select Case char
            Case 48 To 57, 65 To 90, 97 To 122, 45, 46, 95, 126
                output = output & Chr(char)
            Case Else
                output = output & "%" & Hex(char)
        End Select
    Next i
    
    URLEncode = output
End Function

使用注意事项 #

1. JSON解析依赖：需导入VBA-JSON模块（可在VBA编辑器中导入该模块实现JSON解析，无需额外外部工具）
2. API密钥获取：前往ORS官网注册账号，获取免费API密钥（免费额度满足普通使用需求）
3. 出行模式切换：修改ORS_DIRECTIONS_URL中的driving-car可切换为其他模式：
   • 步行：walking-hiking
   • 普通骑行：cycling-regular
   • 重型车辆：driving-hgv
4. 单位转换：若需将米转换为公里，直接将返回值除以1000即可；转换为英里则乘以0.000621371

与原Google Maps代码的核心差异 #

内容的提问来源于stack exchange，提问作者Marshall Jenkins