Bildabmessungen einer JPG-Datei - VBA-Script

[TMC]

Ich werfe hier mal *ungetestet* ein VBA-Script rein, mit dem die Bildabmessung eines JPEG-Bildes festgestellt werden kann. Hatte ich mal aus dem Web gezogen, allerdings leider keinen Quellen-Link mehr (ist tot) .....


Sub prüfenJPG()
Dim Width As Long, Height As Long, iCounter As Long
Dim Pfad As Variant, DateiName() As String
Dim ret As Boolean
Dim dName As String

icount = -1
Pfad = Application.GetOpenFilename("Text Files (*.jpg), *.jpg")

If Pfad <> False Then
    ret = SizeJPG(Pfad, Width, Height)
       
    If ret Then
        DateiName = Split(Pfad, "\")
   
        Do Until dName <> "" Or iCounter > 100
            iCounter = iCounter + 1
            If InStr(1, DateiName(iCounter), "jpg") Or InStr(1, DateiName(iCounter), "JPG") Then _
                dName = DateiName(iCounter)
        Loop

        MsgBox "Das Bild : " & dName & " hat die Formate:" & vbLf & _
            "Höhe:" & vbTab & Height & vbLf & _
            "Breite:" & vbTab & Width
    Else
        MsgBox "Es handelt sich nicht um eine JPG-Datei!", vbCritical, "INFO"
    End If
Else
    MsgBox "Vorgang wurde vom Benutzer abgebrochen!", vbInformation, "INFO"
End If
End Sub

Public Function SizeJPG(ByRef FilePath As Variant, Width As Long, _
 Height As Long) As Boolean

  Dim nFNr As Long
  Dim nFlag As Integer
  Dim nDummy As String
  Dim nOffset As Long
  Dim nValue As String
  Dim nWidth As Long
  Dim nHeight As Long
 
  nFNr = FreeFile
  Open FilePath For Binary Access Read As #nFNr
    If Input$(1, #nFNr) <> Chr$(255) Then
      Close #nFNr
      Exit Function
    End If
    nFlag = Asc(Input$(1, #nFNr))
    If nFlag <> &HD8 Then
      Close #nFNr
      Exit Function
    End If
    nDummy = Input$(2, #nFNr)
    Do
      nOffset = Asc(Input$(1, #nFNr)) * 256 + _
       Asc(Input$(1, #nFNr))
      nValue = Input$(nOffset - 2, #nFNr)
      If (nFlag = &HC0) Or (nFlag = &HC2) Then
        nWidth = Asc(Mid$(nValue, 4, 1))
        nWidth = nWidth * 256 + Asc(Mid$(nValue, 5, 1))
        nHeight = Asc(Mid$(nValue, 2, 1))
        nHeight = nHeight * 256 + Asc(Mid$(nValue, 3, 1))
      End If
      If Input$(1, #nFNr) <> Chr$(255) Then
        Exit Do
      End If
      nFlag = Asc(Input$(1, #nFNr))
    Loop While nFlag <> &HD9
  Close #nFNr
  Width = nWidth
  Height = nHeight
  SizeJPG = True
End Function