使用内置GPS接收器与VBA获取GPS坐标技术问询

嘿，针对你用HP XP2平板（内置HP Graff GNSS模块，搭配u-blox GNSS Location Sensor Driver）通过Access VBA获取GPS经纬度并存入数据库的需求，我整理了两种可行的实现方案，从简单的系统API调用到直接读取串口NMEA数据，都给你安排上了：

首先得建一个用来存储GPS数据的表，推荐表名GPSLocations，字段设置如下：

• ID：自动编号（设为主键，确保每条记录唯一）
• Latitude：双精度型（用来存储纬度值，支持正负，对应南北半球）
• Longitude：双精度型（存储经度值，支持正负，对应东西半球）
• RecordedTime：日期/时间型（记录获取GPS坐标的时间戳）

这个方案利用Windows系统自带的位置服务API，不需要直接操作硬件，兼容性更好，前提是你的平板已经正确安装u-blox驱动且开启了位置服务。

Option Compare Database
Option Explicit

' 自定义类型，用来存储GPS坐标和时间
Private Type GPSData
    Latitude As Double
    Longitude As Double
    CaptureTime As Date
End Type

Public Sub CaptureAndSaveGPS()
    Dim geoLocator As Object
    Dim geoPosition As Object
    Dim gpsInfo As GPSData
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    
    On Error GoTo ErrorHandling
    
    ' 初始化Windows位置服务对象（后期绑定，无需额外添加引用）
    Set geoLocator = CreateObject("Windows.Devices.Geolocation.Geolocator")
    
    ' 请求获取位置，设置5秒超时（可根据信号强度调整）
    Set geoPosition = geoLocator.GetGeopositionAsync().WaitForCompletion(5000)
    
    If Not geoPosition Is Nothing Then
        ' 提取经纬度和时间戳
        gpsInfo.Latitude = geoPosition.Coordinate.Point.Position.Latitude
        gpsInfo.Longitude = geoPosition.Coordinate.Point.Position.Longitude
        gpsInfo.CaptureTime = geoPosition.Coordinate.Timestamp
        
        ' 写入Access数据库
        Set db = CurrentDb()
        Set rs = db.OpenRecordset("GPSLocations", dbOpenDynaset)
        
        rs.AddNew
        rs("Latitude") = gpsInfo.Latitude
        rs("Longitude") = gpsInfo.Longitude
        rs("RecordedTime") = gpsInfo.CaptureTime
        rs.Update
        
        MsgBox "GPS坐标已成功保存！" & vbCrLf & _
               "纬度：" & Round(gpsInfo.Latitude, 6) & vbCrLf & _
               "经度：" & Round(gpsInfo.Longitude, 6), vbInformation, "操作成功"
    Else
        MsgBox "无法获取GPS数据，请检查以下内容：" & vbCrLf & _
               "1. Windows位置服务是否已开启" & vbCrLf & _
               "2. HP Graff GNSS模块是否正常识别" & vbCrLf & _
               "3. u-blox驱动是否正确安装", vbExclamation, "获取失败"
    End If

Cleanup:
    ' 释放所有对象，避免内存泄漏
    If Not rs Is Nothing Then rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set geoPosition = Nothing
    Set geoLocator = Nothing
    Exit Sub

ErrorHandling:
    MsgBox "发生错误：" & Err.Description & vbCrLf & _
           "错误代码：" & Err.Number, vbCritical, "错误提示"
    Resume Cleanup
End Sub

方案一的关键注意事项 #

• 位置权限：必须在Windows设置中开启位置服务，并允许Access访问位置信息（路径：设置 > 隐私和安全性 > 位置）
• 驱动验证：在设备管理器的「传感器」分类下，确认能看到HP Graff GNSS Module，且驱动状态正常
• 超时调整：如果你的平板经常处于信号弱的环境，可以把WaitForCompletion(5000)的参数调大（单位是毫秒）
• 系统兼容性：该API支持Windows 10及以上版本，HP XP2平板的系统版本需符合要求

如果方案一无法正常获取数据（比如系统位置服务被禁用），可以直接读取GNSS模块的串口数据，解析NMEA协议中的$GPGGA语句（这是包含经纬度的核心语句）。

Option Compare Database
Option Explicit

Public Sub ReadGPSFromSerialPort()
    Dim commPort As Object
    Dim nmeaLine As String
    Dim dataParts() As String
    Dim latValue As Double
    Dim lonValue As Double
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    
    On Error GoTo ErrorHandling
    
    ' 初始化串口对象（后期绑定，无需添加Microsoft Comm Control引用）
    Set commPort = CreateObject("MSCommLib.MSComm")
    
    ' 配置串口参数（先在设备管理器中找到模块对应的COM端口，比如COM3）
    commPort.CommPort = 3 ' 替换为你的GNSS模块实际COM端口
    commPort.Settings = "9600,N,8,1" ' u-blox模块默认参数：9600波特率、无校验、8位数据位、1位停止位
    commPort.PortOpen = True
    commPort.InputLen = 0 ' 读取所有可用数据
    
    ' 循环读取NMEA语句，直到获取有效坐标
    Do
        nmeaLine = commPort.Input
        ' 筛选出$GPGGA语句（包含经纬度信息）
        If Left(Trim(nmeaLine), 6) = "$GPGGA" Then
            dataParts = Split(nmeaLine, ",")
            
            ' 解析纬度：格式为DDMM.MMMMM，转换为十进制
            If dataParts(2) <> "" Then
                latValue = Val(Left(dataParts(2), 2)) + Val(Mid(dataParts(2), 3)) / 60
                If dataParts(3) = "S" Then latValue = -latValue ' 南半球为负
            End If
            
            ' 解析经度：格式为DDDMM.MMMMM，转换为十进制
            If dataParts(4) <> "" Then
                lonValue = Val(Left(dataParts(4), 3)) + Val(Mid(dataParts(4), 4)) / 60
                If dataParts(5) = "W" Then lonValue = -lonValue ' 西半球为负
            End If
            
            ' 写入数据库
            Set db = CurrentDb()
            Set rs = db.OpenRecordset("GPSLocations", dbOpenDynaset)
            
            rs.AddNew
            rs("Latitude") = latValue
            rs("Longitude") = lonValue
            rs("RecordedTime") = Now()
            rs.Update
            
            MsgBox "通过串口获取并保存坐标！" & vbCrLf & _
                   "纬度：" & Round(latValue, 6) & vbCrLf & _
                   "经度：" & Round(lonValue, 6), vbInformation, "操作成功"
            Exit Do
        End If
    Loop Until commPort.PortOpen = False

Cleanup:
    ' 关闭串口并释放对象
    If commPort.PortOpen Then commPort.PortOpen = False
    Set commPort = Nothing
    If Not rs Is Nothing Then rs.Close
    Set rs = Nothing
    Set db = Nothing
    Exit Sub

ErrorHandling:
    MsgBox "串口读取错误：" & Err.Description & vbCrLf & _
           "错误代码：" & Err.Number, vbCritical, "错误提示"
    Resume Cleanup
End Sub

方案二的关键注意事项 #

• COM端口确认：在设备管理器的「端口(COM和LPT)」分类下找到HP Graff GNSS模块对应的端口号，替换代码中的commPort.CommPort = 3
• 串口参数匹配：如果你的模块参数不是默认的9600波特率，需要修改commPort.Settings的值
• NMEA解析容错：如果GPS信号弱，NMEA字段可能为空，代码中已做基础空值判断，可根据需求扩展容错逻辑

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