Sub GetCoordinates()
    Dim fso As Object
    Dim objShell As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim strPath As String
    Dim arrDetails As Variant
    Dim latRef As String, lonRef As String
    Dim latDeg As Double, latMin As Double, latSec As Double, lonDeg As Double, lonMin As Double, lonSec As Double, alt As Double
    Dim i As Integer
    
    'Путь к файлу
    strPath = "C:\Users\MininDO\Desktop\ExifTool\0-5\4_[10].JPG"
    
    'Создание объектов
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(fso.GetParentFolderName(strPath))
    Set objFile = objFolder.ParseName(fso.GetFileName(strPath))
    
    'Получение деталей файла
    arrDetails = Split(objFolder.GetDetailsOf(objFile, 27), ";")
    
    'Извлечение координат
    For i = 0 To UBound(arrDetails)
        If InStr(arrDetails(i), "GPS Latitude Ref") > 0 Then
            latRef = arrDetails(i + 1)
        ElseIf InStr(arrDetails(i), "GPS Latitude") > 0 Then
            latDeg = CDbl(Split(arrDetails(i + 1), "°")(0))
            latMin = CDbl(Split(arrDetails(i + 1), "°")(1))
            latSec = CDbl(Split(Split(arrDetails(i + 1), "°")(2), ".")(0))
        ElseIf InStr(arrDetails(i), "GPS Longitude Ref") > 0 Then
            lonRef = arrDetails(i + 1)
        ElseIf InStr(arrDetails(i), "GPS Longitude") > 0 Then
            lonDeg = CDbl(Split(arrDetails(i + 1), "°")(0))
            lonMin = CDbl(Split(arrDetails(i + 1), "°")(1))
            lonSec = CDbl(Split(Split(arrDetails(i + 1), "°")(2), ".")(0))
        ElseIf InStr(arrDetails(i), "GPS Altitude") > 0 Then
            alt = CDbl(Replace(arrDetails(i + 1), " m", ""))
        End If
    Next i
    
    'Преобразование координат в десятичные градусы
    If latRef = "S" Then
        latDeg = -latDeg
    End If
    If lonRef = "W" Then
        lonDeg = -lonDeg
    End If
    latDeg = latDeg + (latMin / 60) + (latSec / 3600)
    lonDeg = lonDeg + (lonMin / 60) + (lonSec / 3600)
    
    'Вывод координат в ячейки Excel
    Sheets("Sheet1").Range("A1").Value = latDeg
    Sheets("Sheet1").Range("B1").Value = lonDeg
    Sheets("Sheet1").Range("C1").Value = alt
    
    'Очистка объектов
    Set fso = Nothing
    Set objShell = Nothing
    Set objFolder = Nothing
    Set objFile = Nothing
End Sub