VBA读取OpenStreetMap API结果异常，MSAccess地址自动补全经纬度问题

1. 先添加URLEncode工具函数 #

先在VBA模块中新增如下通用编码函数，兼容所有Access版本，可处理包含特殊字符、非拉丁语言的地址参数：

Public Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String
    Dim StringLen As Long: StringLen = Len(StringVal)
    If StringLen = 0 Then
        URLEncode = ""
        Exit Function
    End If
    Dim result As String, i As Long, CharCode As Integer
    Dim Char As String, Space As String
    If SpaceAsPlus Then Space = "+" Else Space = "%20"
    For i = 1 To StringLen
        Char = Mid(StringVal, i, 1)
        CharCode = Asc(Char)
        Select Case CharCode
        Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
            result = result & Char
        Case 32
            result = result & Space
        Case 0 To 15
            result = result & "%0" & Hex(CharCode)
        Case Else
            result = result & "%" & Hex(CharCode)
        End Select
    Next
    URLEncode = result
End Function

2. 修改GetCoordinates主函数 #

核心调整点包括：移除谷歌接口专属的密钥校验、新增User-Agent请求头、适配Nominatim的XML结构解析逻辑：

Public Function GetCoordinates(address As String) As String
    On Error GoTo errorHandler
    Dim xmlhttpRequest      As Object
    Dim xmlDoc              As Object
    Dim placeNode           As Object
    
    ' 创建请求对象
    Set xmlhttpRequest = CreateObject("MSXML2.ServerXMLHTTP")
    If xmlhttpRequest Is Nothing Then
        GetCoordinates = "无法创建请求对象"
        Exit Function
    End If
    
    ' 构造Nominatim请求，使用URLEncode处理地址
    Dim encodedAddress As String
    encodedAddress = URLEncode(address, True) ' 空格替换为+符合接口要求
    xmlhttpRequest.Open "GET", "https://nominatim.openstreetmap.org/search?q=" & encodedAddress & "&format=xml&addressdetails=1", False
    ' 必须设置User-Agent，否则Nominatim可能拦截请求
    xmlhttpRequest.setRequestHeader "User-Agent", "AccessGeocode/1.0"
    xmlhttpRequest.send
    
    ' 加载返回的XML
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    xmlDoc.async = False
    xmlDoc.validateOnParse = False
    If Not xmlDoc.LoadXML(xmlhttpRequest.responseText) Then
        GetCoordinates = "XML解析失败: " & xmlDoc.parseError.reason
        GoTo errorHandler
    End If
    
    ' 查找第一个place节点
    Set placeNode = xmlDoc.SelectSingleNode("//searchresults/place[1]")
    If placeNode Is Nothing Then
        GetCoordinates = "未找到匹配的地址"
        GoTo errorHandler
    End If
    
    ' 读取place节点的lat、lon属性值（注意Nominatim的经纬度是节点属性，不是子节点）
    GetCoordinates = placeNode.getAttribute("lat") & ", " & placeNode.getAttribute("lon")
    
errorHandler:
    Set placeNode = Nothing
    Set xmlDoc = Nothing
    Set xmlhttpRequest = Nothing
    If Err.Number <> 0 Then
        GetCoordinates = "请求错误: " & Err.Description
    End If
End Function

关键说明 #

• Nominatim返回的lat和lon是<place>标签的属性，不是子节点，直接用getAttribute方法读取即可
• 调用Nominatim必须设置合法的User-Agent头，否则会被接口拒绝返回结果
• URLEncode函数会自动处理波兰语等特殊字符的编码，避免地址乱码导致无结果返回
• 针对地址缩写问题，可额外新增缩写映射规则，在调用接口前自动把gm.替换为gmina等规范表述，进一步提升匹配率

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