How can I extract the "Compression" attribute from a jpeg file in Windows 10 using VBA (or PowerShell)?

Question

I'm trying to extract the Compression attribute from several thousand jpeg files.

How can I do this with either Excel VBA or PowerShell (or some other method)?

Some users haven't used the correct technique to convert tiff or png files to jpegs. They just edited the file extension directly in Explorer instead of using an app like Photoshop to properly change the file format. This is causing trouble in a downstream process.

After checking a few files, the problematic ones have 'Uncompressed' in that field...and I want to isolate these so they can be corrected.

Note that This answer does not provide the solution I need. The Compression attribute is not in the list of 308 attributes output by that method.

Answer 1

From my earlier comment - if your aim is really to id the actual file type (vs. relying on the file extension)

Sub Tester()

    Const fldr As String = "C:\Temp\pics\"
    
    Debug.Print FileTypeId(fldr & "photo.jpg")
    Debug.Print FileTypeId(fldr & "unlock.gif")
    Debug.Print FileTypeId(fldr & "unlock2.png")
    Debug.Print FileTypeId(fldr & "sample.tiff")

End Sub


Function FileTypeId(fPath As String) As String

    Dim bytes() As Byte, ff As Integer, i As Long
    
    'read the file into an array of bytes
    ff = FreeFile
    Open fPath For Binary Access Read As ff
    ReDim bytes(0 To LOF(ff) - 1) 'maybe don't need to read more than the first 10 bytes or so...
    Get ff, , bytes
    Close ff

    'Does the file match any of our "known" types?
    '  File signatures are taken from:
    '  https://www.garykessler.net/library/file_sigs.html
    Select Case True
        Case ByteMatch(bytes, Array(&HFF, &HD8))
            FileTypeId = "JPEG"
        Case ByteMatch(bytes, Array(&H47, &H49, &H46, &H38, &H37, &H61)), _
             ByteMatch(bytes, Array(&H47, &H49, &H46, &H38, &H39, &H61))
             FileTypeId = "GIF"
        Case ByteMatch(bytes, Array(&H89, &H50, &H4E, &H47, &HD, &HA, &H1A, &HA))
            FileTypeId = "PNG"
        Case ByteMatch(bytes, Array(&H49, &H49, &H2A, &H0))
            FileTypeId = "TIFF"
        Case Else
            FileTypeId = "unknown"
    End Select
    
'    Debug.Print fPath
'    Debug.Print FileTypeId
'    For i = LBound(bytes) To 6
'        Debug.Print Hex(bytes(i))
'    Next i
End Function

'do the first elements in `bytes` match `sig` ? 
Function ByteMatch(bytes, sig) As Boolean
    Dim i As Long
    For i = LBound(sig) To UBound(sig)
        If bytes(i) <> sig(i) Then
           ByteMatch = False
           Exit Function
        End If
    Next i
    ByteMatch = True
End Function