XL 2016 Extraire propriété d'une seule image dans repertoire courant

Sub Test_OK()
'ici remplacer par le chemin du dossier puis par le nom de l'image
'ne pas oublier le \ de fin et l'extension de l'image
Lire_IMG "C:\Users\STAPLE\Pictures\NICEPHORE\", "CIMG0616.JPG"
End Sub
Private Sub Lire_IMG(Chemin$, NomIMG$)
Dim t, tt
t = Split(Lire_Proprietes_IMG(Chemin & NomIMG, 0), ";")
tt = Split(Lire_Proprietes_IMG(Chemin & NomIMG, 39), ";")
Range("A1").Resize(UBound(t)) = Application.Transpose(t)
Range("B1").Resize(UBound(tt)) = Application.Transpose(tt)
End Sub
Function Lire_Proprietes_IMG(strFilewFullPath, iDoHeaders As Integer)
'fonction originale:GetFileProperties2
'par Shasur M
Const arrSize = 39
Dim strFile$, strFileName, strPath$, sTemp As Variant, I%, fsize%
Dim idate As Date, idimension$, Camera$, objShell As Object
Dim arrHeaders(arrSize)
Dim objFolder As Object, oFile As Object, arTemp
Set objShell = CreateObject("Shell.Application") '=====
strFile = Dir(strFilewFullPath)
strPath = Left(strFilewFullPath, InStrRev(strFilewFullPath, "\") - 1)
arTemp = Split(strFilewFullPath, "\")
strFileName = arTemp(UBound(arTemp))
Set objFolder = objShell.Namespace(strPath & "\")
For I = 0 To arrSize
  arrHeaders(I) = objFolder.GetDetailsOf(objFolder.Items, I)
Next I
Lire_Proprietes_IMG = ""
Set oFile = objFolder.ParseName(strFileName)

For I = 0 To arrSize
  sTemp = arrHeaders(I)
  If iDoHeaders = 0 Then
    If IsNull(sTemp) Or sTemp = "" Then sTemp = "Manquant"
    Lire_Proprietes_IMG = Lire_Proprietes_IMG & sTemp & ";"
   Else
    sTemp = objFolder.GetDetailsOf(oFile, I)
    If IsNull(sTemp) Then sTemp = "Manquant"
    Lire_Proprietes_IMG = Lire_Proprietes_IMG & sTemp & ";"
   End If
Next I
End Function

Sub Test_OK_B()
'ici remplacer par le chemin du dossier puis par le nom de l'image
'ne pas oublier le \ de fin et l'extension de l'image
Dim strPath$
strPath = ThisWorkbook.Path & "\"
Lire_IMG strPath, "CIMG0616.JPG"
End Sub

Sub Pour_Les_Photographes()
'+++++++++++++++++++++++++++++++++++++++
'adapté du code SilkyRoad
'cocher la référence à WIA Library
'C:\Windows\System32\wiaaut.dll
'+++++++++++++++++++++++++++++++++++++++
Dim Img As Object, P As Property, S$, t
'Création conteneur pour l'image à manipuler
    Set Img = CreateObject("WIA.imageFile")
    'Chargement de l'image dans le conteneur
    Img.LoadFile ("C:\Users\STAPLE\Pictures\CIMG0616.JPG")
    'Boucle sur la collection de propriétés
    For Each P In Img.Properties
        S = P.Name & "(" & P.PropertyID & ") = "
        If P.IsVector Then
            S = S & " * vector data not emitted * "
            ElseIf P.Type = RationalImagePropertyType Then
            S = S & P.Value.Numerator & "/" & P.Value.Denominator
            ElseIf P.Type = StringImagePropertyType Then
            S = S & """" & P.Value & """"
            Else
            S = S & P.Value
        End If
        tt = tt & S & "²"
    Next
  t = Split(tt, "²")
  Range("A1").Resize(UBound(t)) = Application.Transpose(t)
  Range("A1").CurrentRegion.TextToColumns _
        Destination:=Range("A1"), DataType:=xlDelimited, Other:=True, _
        OtherChar:="=", FieldInfo:=Array(Array(1, 1), Array(2, 2))
End Sub