Manipulation d'une pièce jointe outlook en VBA

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)

'Variables
Dim arrID() As String
Dim i, j As Integer
Dim ns_outlook As outlook.NameSpace
Dim item_outlook As MailItem
Dim itm As outlook.MailItem
Dim expéditeur As String
Dim objet_email As String
Dim outlook As Object
Dim outlookMail As Object
Dim Mesattachements As outlook.Attachments
Dim Piecejointe As outlook.Attachments
'En cas d'erreur
On Error Resume Next
Set ns_outlook = Application.Session
'Séparer le matricule de l'objet Outlook
arrID = Split(EntryIDCollection, ",")
For i = 0 To UBound(arrID)
    Set item_outlook = ns_outlook.GetItemFromID(arrID(i))
    If item_outlook.Class = olMail Then
    
        Set itm = item_outlook
        expediteur = itm.SenderName
        objet_email = itm.Subject
        Set Mesattachements = itm.Attachments
        If Mesattachements.Count > 0 And Right(UCase(Mesattachements(1).FileName), 4) = ".PNG" Then
        'La pièce jointe est une image PNG
        If expediteur = "XXXXX" And objet_email = "TEST" Then
        Set Piecejointe = itm.Attachments(1)
                Set outlook = CreateObject("Outlook.Application")
                Set outlookMail = outlook.CreateItem(0)
                stringbody = "<B><SPAN STYLE='font-family: Segoe UI; font-size:21'>Suivi Quotidien</SPAN></B><br>"
                stringbody = stringbody & "<SPAN STYLE='font-family: Segoe UI; font-size:12'>Veuillez trouver ci-après le document actualisé.</SPAN><br><br>"
                stringbody = stringbody & "<SPAN STYLE='font-family: Segoe UI; font-size:12'>Cordialement" & " </SPAN>"
                'stringbody = stringbody & "<IMG src""cid:
                With outlookMail
                    .Display
                    .To = "ZZZZZZZZZ"
                    .Subject = "SUJET DU MESSAGE"
                    .HTMLBody = stringbody & .HTMLBody
                    '.Attachments = piecejointe  
                    .Display
                    .Send
                End With
        End If
        End If
    End If
Next

Set ns_outlook = Nothing
Set item_outlook = Nothing
Set itm = Nothing
Set Piecejointe = Nothing

End Sub