Resolution Pixel per cm

Enum TiffResolutionUnit
    NoUnit 'Failed or file is no Tiff
    NoAbsolutUnit
    Inch
    Centimeter
End Enum


Public Function getTiffResolution(sFile As String) As TiffResolutionUnit

Dim fFormat As String
Dim Data2 As Integer
Dim Data4 As Long
Dim FN As Integer
Dim i As Integer
Dim buffer() As Byte
Dim resString As String

getTiffResolution = NoUnit

  FN = FreeFile
  
  Open sFile For Binary Access Read As FN
  
  fFormat = Space$(2)

    Get FN, , fFormat
    
    ReDim buffer(1)
    
    Get FN, , buffer
    Data2 = buffer(0) + buffer(1) ' 42 = tiff
    If Data2 <> 42 Then
        Exit Function
    End If
    
    ReDim buffer(3)
        
    Get FN, , buffer 'First IFD
    Data4 = buffer(0) + buffer(1) + buffer(2) + buffer(3)
        
    Seek FN, Data4 + 1 'Goto first IFD
    ReDim buffer(1)
    
    Get FN, , buffer
    Data2 = buffer(0) + buffer(1)  'IFD Entries
    
    For i = 1 To Data2
    ReDim buffer(11)
    Get FN, , buffer
    If fFormat = "II" Then
    resString = Hex(buffer(1)) & Hex(buffer(0))
    Else
    resString = Hex(buffer(0)) & Hex(buffer(1))
    End If
        If resString = "128" Then
        getTiffResolution = buffer(8) + buffer(9) + buffer(10) + buffer(11)
        Exit For
        End If
    Next
    
  Close FN

End Function