从图片提取GPS数据至Excel遇运行时错误，求VB代码排查解决

问题根源 #

1. 无GPS数据的图片触发错误：不是所有图片都嵌入了GPS元数据，直接访问不存在的属性会抛出-2145320854错误。
2. 数据类型不匹配：GPS经度/纬度以度分秒数组形式存储，而非Long类型，直接赋值会导致类型转换失败。
3. WIA属性访问不可靠：使用属性名称（如"GPS Longitude"）访问可能存在兼容性问题，需先检查属性是否存在。

修改后的代码 #

Sub ExtractPhotoData()
    '声明变量
    Dim FSO As Object
    Dim SourceFolder As Object
    Dim FileItem As Object
    Dim Image As Object
    Dim RowCounter As Integer
    Dim prop As Object
    Dim lonDegrees As Double, lonMinutes As Double, lonSeconds As Double
    Dim latDegrees As Double, latMinutes As Double, latSeconds As Double
    Dim longitude As Double, latitude As Double
    Dim altitude As Double
    
    RowCounter = 1
    
    '设置文件系统对象和源文件夹
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.GetFolder(Worksheets("Sheet2").Cells(2, 9).Value)
    
    '遍历文件夹内的每个文件
    For Each FileItem In SourceFolder.Files
        '仅处理常见图片格式（可按需扩展）
        If LCase(FSO.GetExtensionName(FileItem.Path)) Like "jpg" Or _
           LCase(FSO.GetExtensionName(FileItem.Path)) Like "jpeg" Or _
           LCase(FSO.GetExtensionName(FileItem.Path)) Like "png" Then
            
            On Error Resume Next '临时启用错误处理，跳过异常文件
            Set Image = CreateObject("WIA.ImageFile")
            Image.LoadFile FileItem.Path
            If Err.Number <> 0 Then
                Err.Clear
                GoTo NextFile '加载失败则跳过当前文件
            End If
            On Error GoTo 0 '恢复默认错误处理
            
            '初始化坐标值为空白
            longitude = Empty
            latitude = Empty
            altitude = Empty
            
            '提取并转换GPS经度
            Set prop = Image.Properties("GPS Longitude")
            If Not prop Is Nothing Then
                lonDegrees = prop.Value(0)
                lonMinutes = prop.Value(1)
                lonSeconds = prop.Value(2)
                '根据东经/西经调整符号，转换为十进制坐标
                If Image.Properties("GPS Longitude Ref").Value = "W" Then
                    longitude = -(lonDegrees + lonMinutes / 60 + lonSeconds / 3600)
                Else
                    longitude = lonDegrees + lonMinutes / 60 + lonSeconds / 3600
                End If
            End If
            
            '提取并转换GPS纬度
            Set prop = Image.Properties("GPS Latitude")
            If Not prop Is Nothing Then
                latDegrees = prop.Value(0)
                latMinutes = prop.Value(1)
                latSeconds = prop.Value(2)
                '根据北纬/南纬调整符号，转换为十进制坐标
                If Image.Properties("GPS Latitude Ref").Value = "S" Then
                    latitude = -(latDegrees + latMinutes / 60 + latSeconds / 3600)
                Else
                    latitude = latDegrees + latMinutes / 60 + latSeconds / 3600
                End If
            End If
            
            '提取GPS海拔
            Set prop = Image.Properties("GPS Altitude")
            If Not prop Is Nothing Then
                altitude = prop.Value
                '可选：根据海拔参考调整符号（1表示低于海平面）
                'If Image.Properties("GPS Altitude Ref").Value = 1 Then altitude = -altitude
            End If
            
            '写入Excel表格
            RowCounter = RowCounter + 1
            Cells(RowCounter, 1).Value = FileItem.Name
            Cells(RowCounter, 2).Value = longitude
            Cells(RowCounter, 3).Value = latitude
            Cells(RowCounter, 4).Value = altitude
        End If
        
NextFile:
    Next FileItem
    
    '释放对象资源
    Set Image = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub

关键改进点 #

• 错误处理：通过临时错误捕获跳过加载失败或无GPS数据的图片，避免程序崩溃。
• 文件过滤：仅处理JPG/JPEG/PNG等常见图片格式，减少无效操作。
• 坐标转换：将度分秒格式转换为通用的十进制坐标，并根据经纬度方向调整符号。
• 属性检查：先判断GPS属性是否存在，再执行赋值操作，避免空对象错误。

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