使用Bing API的VBA宏反向距离计算异常求助（涉邮编36088）

问题现象 #

• 基于Bing API开发的VBA宏计算德国邮编36088与10117的距离时，36088→10117的结果为436.809km，符合预期；但10117→36088的结果仅为43.466km，明显错误。
• 仅邮编36088存在此反向计算异常，已排查常规问题但未定位原因。

原宏代码 #

Public Function GetDistance(start As String, dest As String) As String
Dim myKey As String: myKey = "APIKEY BING"
Dim objHTTP As Object
Dim regex As Object
Dim matches As Object
Dim coordinates1 As String
Dim coordinates2 As String
Dim distance As Double
Dim result As String

    ' 创建HTTP请求对象
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    
    ' 获取起点坐标
    objHTTP.Open "GET", "http://dev.virtualearth.net/REST/v1/Locations?q=" & start & "&key=" & myKey, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    
    ' 验证响应是否包含坐标信息
    If InStr(objHTTP.responseText, "coordinates") = 0 Then GoTo ErrorHandl
    
    ' 正则提取坐标
    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = "(?=.*)\[([0-9]+.[0-9]+,[0-9]+.[0-9]+)\]": regex.Global = False
    Set matches = regex.Execute(objHTTP.responseText)
    coordinates1 = matches(0).SubMatches(0)
    
    ' 获取终点坐标
    objHTTP.Open "GET", "http://dev.virtualearth.net/REST/v1/Locations?q=" & dest & "&key=" & myKey, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    
    ' 验证响应是否包含坐标信息
    If InStr(objHTTP.responseText, "coordinates") = 0 Then GoTo ErrorHandl
    
    ' 正则提取坐标
    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = "(?=.*)\[([0-9]+.[0-9]+,[0-9]+.[0-9]+)\]": regex.Global = False
    Set matches = regex.Execute(objHTTP.responseText)
    coordinates2 = matches(0).SubMatches(0)
    
    ' 请求距离矩阵API
    objHTTP.Open "GET", "https://dev.virtualearth.net/REST/v1/Routes/DistanceMatrix?origins=" & coordinates1 & "&destinations=" & coordinates2 & "&travelMode=driving&distanceUnit=km&output=json&key=" & myKey, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    
    ' 验证响应是否包含距离信息
    If InStr(objHTTP.responseText, "travelDistance") = 0 Then GoTo ErrorHandl
    
    ' 正则提取距离值并转换
    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = "([0-9]+\.[0-9]+)": regex.Global = True
    Set matches = regex.Execute(objHTTP.responseText)
    distance = CDbl(matches(4)) / 1000
    
    ' 返回结果
    GetDistance = distance
    Exit Function

ErrorHandl:
' 错误提示
MsgBox (objHTTP.responseText), vbCritical, "ERROR"
GetDistance = "Fehler"
End Function

问题根因 #

核心问题出在正则提取距离的硬编码索引：
原代码通过matches(4)提取数值，但Bing API返回的JSON中，数值的顺序会因请求参数（如起点/终点切换）发生变化。当10117作为起点、36088作为终点时，matches(4)取到的不是travelDistance字段的值，而是其他无关数值（比如行驶时间或坐标参数），导致结果异常。

此外，正则提取坐标的方式也存在风险：若API返回多个匹配坐标（如重名地址），正则会默认取第一个，可能导致坐标错误。

解决方案 #

方案1：使用JSON解析器（推荐） #

放弃正则提取，改用VBA-JSON库解析API返回的JSON结构，精准定位目标字段，彻底避免索引依赖问题。

步骤：

1. 导入VBA-JSON库（通过VBA编辑器的「工具→引用」添加，或导入对应模块）
2. 修改宏代码如下：

Public Function GetDistance(start As String, dest As String) As Double
    Dim myKey As String: myKey = "你的Bing API密钥"
    Dim objHTTP As Object
    Dim json As Object
    Dim lat1 As Double, lon1 As Double
    Dim lat2 As Double, lon2 As Double
    Dim distance As Double
    
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    
    ' 获取起点经纬度
    objHTTP.Open "GET", "http://dev.virtualearth.net/REST/v1/Locations?q=" & start & "&key=" & myKey, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send
    If objHTTP.Status <> 200 Then GoTo ErrorHandl
    
    Set json = JsonConverter.ParseJson(objHTTP.responseText)
    lat1 = json("resourceSets")(1)("resources")(1)("point")("coordinates")(1)
    lon1 = json("resourceSets")(1)("resources")(1)("point")("coordinates")(2)
    
    ' 获取终点经纬度
    objHTTP.Open "GET", "http://dev.virtualearth.net/REST/v1/Locations?q=" & dest & "&key=" & myKey, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send
    If objHTTP.Status <> 200 Then GoTo ErrorHandl
    
    Set json = JsonConverter.ParseJson(objHTTP.responseText)
    lat2 = json("resourceSets")(1)("resources")(1)("point")("coordinates")(1)
    lon2 = json("resourceSets")(1)("resources")(1)("point")("coordinates")(2)
    
    ' 请求距离矩阵API
    objHTTP.Open "GET", "https://dev.virtualearth.net/REST/v1/Routes/DistanceMatrix?origins=" & lat1 & "," & lon1 & "&destinations=" & lat2 & "," & lon2 & "&travelMode=driving&distanceUnit=km&output=json&key=" & myKey, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send
    If objHTTP.Status <> 200 Then GoTo ErrorHandl
    
    Set json = JsonConverter.ParseJson(objHTTP.responseText)
    distance = json("resourceSets")(1)("resources")(1)("results")(1)("travelDistance")
    
    GetDistance = distance
    Exit Function

ErrorHandl:
    MsgBox objHTTP.responseText, vbCritical, "错误"
    GetDistance = -1
End Function

方案2：临时修复正则索引 #

若暂时无法使用JSON库，可先打印API返回的完整响应文本，找到10117→36088请求中travelDistance对应的matches索引，替换原代码中的matches(4)。但此方法不持久，API结构变动后会再次失效。

额外检查点 #

• 验证36088作为终点时的坐标是否正确：手动调用Bing Locations API，确认返回的坐标是德国的正确位置，避免API返回其他地区的同邮编地址。
• 增加API状态码检查：原代码仅判断响应是否包含特定字符串，添加objHTTP.Status = 200判断可更准确捕获请求错误。

内容的提问来源于stack exchange，提问作者Mustafa Erk