ExcelVBA打开文件夹并获取其中每个文件的GPS信息（Exif）（2）

我正在尝试使用Wayne Phillips类模块代码（EXIFReader访问应用程序）和David Zemens子例程从jpg文件（GPS纬度和经度数据，嵌入在用Nikon Coolpix W300相机拍摄的照片中嵌入）中检索Exif元数据。 Excel VBA打开文件夹并获取其中的每个文件的GPS信息（Exif）（原始文章的链接：如何使用VBA从excel工作表中的图片中获取EXIF信息）。

在David answare的指导下，我尝试了他提出的所有建议：

1）我从韦恩代码中将类模块导入到我的工作簿项目中；

2）在类模块中，我使用“ PtrSafe”声明修改了声明的函数，使其与Excel 64位兼容；

3）我在普通代码模块上创建了一个完全像David提议的子例程；

4）我已将文件夹路径更新为正确的路径

（Set fldr=fso.GetFolder("C:/users/david_zemens/desktop/")）;

5）我已经编译和调试了项目，当代码运行下面的指令（存储在GPSExifProperties类模块中）时，我遇到了应用程序崩溃：

Property Get GPSLatitudeDecimal() As Variant Call **VCOMObject**.AssignVar(GPSLatitudeDecimal, VCOMObject.GPSLatitudeDecimal) End Property

韦恩的课程模块代码可在以下链接中找到：https : //www.everythingaccess.com/tutorials.asp?ID=Extracting-GPS-data-from-JPEG-files

我尝试使用的David Zemens代码如下：

Sub OpenFromFolder()

On Error GoTo ExifError

    Dim strDump As String
    '## REQUIRES REFERENCE TO MICROSOFT SCRIPTING RUNTIME
    Dim fso As Scripting.FileSystemObject
    Dim fldr As Scripting.Folder
    Dim file As Scripting.file

    Set fso = CreateObject("scripting.filesystemobject")
    Set fldr = fso.GetFolder("E:\DNIT\Relatório Fotográfico\Fotos com dados GPS")  '#### Modify this to your folder location

    For Each file In fldr.Files
    '## ONLY USE JPG EXTENSION FILES!!
    Select Case UCase(Right(file.Name, 3))
        Case "JPG"
            With GPSExifReader.OpenFile(file.Path)

               strDump = strDump & "FilePath:                  " & .FilePath & vbCrLf
               strDump = strDump & "DateTimeOriginal:          " & .DateTimeOriginal & vbCrLf
               strDump = strDump & "GPSVersionID:              " & .GPSVersionID & vbCrLf
               strDump = strDump & "GPSLatitudeDecimal:        " & .GPSLatitudeDecimal & vbCrLf
               strDump = strDump & "GPSLongitudeDecimal:       " & .GPSLongitudeDecimal & vbCrLf
               strDump = strDump & "GPSAltitudeDecimal:        " & .GPSAltitudeDecimal & vbCrLf
               strDump = strDump & "GPSSatellites:             " & .GPSSatellites & vbCrLf
               strDump = strDump & "GPSStatus:                 " & .GPSStatus & vbCrLf
               strDump = strDump & "GPSMeasureMode:            " & .GPSMeasureMode & vbCrLf
               strDump = strDump & "GPSDOPDecimal:             " & .GPSDOPDecimal & vbCrLf
               strDump = strDump & "GPSSpeedRef:               " & .GPSSpeedRef & vbCrLf
               strDump = strDump & "GPSSpeedDecimal:           " & .GPSSpeedDecimal & vbCrLf
               strDump = strDump & "GPSTrackRef:               " & .GPSTrackRef & vbCrLf
               strDump = strDump & "GPSTrackDecimal:           " & .GPSTrackDecimal & vbCrLf
               strDump = strDump & "GPSImgDirectionRef:        " & .GPSImgDirectionRef & vbCrLf
               strDump = strDump & "GPSImgDirectionDecimal:    " & .GPSImgDirectionDecimal & vbCrLf
               strDump = strDump & "GPSMapDatum:               " & .GPSMapDatum & vbCrLf
               strDump = strDump & "GPSDestLatitudeDecimal:    " & .GPSDestLatitudeDecimal & vbCrLf
               strDump = strDump & "GPSDestLongitudeDecimal:   " & .GPSDestLongitudeDecimal & vbCrLf
               strDump = strDump & "GPSDestBearingRef:         " & .GPSDestBearingRef & vbCrLf
               strDump = strDump & "GPSDestBearingDecimal:     " & .GPSDestBearingDecimal & vbCrLf
               strDump = strDump & "GPSDestDistanceRef:        " & .GPSDestDistanceRef & vbCrLf
               strDump = strDump & "GPSDestDistanceDecimal:    " & .GPSDestDistanceDecimal & vbCrLf
               strDump = strDump & "GPSProcessingMethod:       " & .GPSProcessingMethod & vbCrLf
               strDump = strDump & "GPSAreaInformation:        " & .GPSAreaInformation & vbCrLf
               strDump = strDump & "GPSDateStamp:              " & .GPSDateStamp & vbCrLf
               strDump = strDump & "GPSTimeStamp:              " & .GPSTimeStamp & vbCrLf
               strDump = strDump & "GPSDifferentialCorrection: " & .GPSDifferentialCorrection & vbCrLf

               Debug.Print strDump   '## Modify this to print the results wherever you want them...

           End With
       End Select
    NextFile:
        Next
        Exit Sub

    ExifError:
        MsgBox "An error has occurred with file: " & file.Name & vbCrLf & vbCrLf & Err.Description
        Err.Clear
        Resume NextFile

    End Sub

调试它时，使用“ .GPSLatitudeDecimal”指令将代码的第4行运行到With / End With块中，应用程序崩溃。关闭excel应用程序之前，它没有错误消息。我想了解这段代码出了什么问题，以及如何解决该问题并检索制作每月照片报告所需的GPS元数据。

尝试使用WIA.ImageFile从EXIF数据获取GPS坐标，这是示例：

Sub Test()

    With CreateObject("WIA.ImageFile")
        .LoadFile "C:\Test\image.jpg"
        With .Properties("GpsLatitude").Value
            Debug.Print .Item(1).Value + .Item(2).Value / 60 + .Item(3).Value / 3600
        End With
        With .Properties("GpsLongitude").Value
            Debug.Print .Item(1).Value + .Item(2).Value / 60 + .Item(3).Value / 3600
        End With
    End With

End Sub