Récuperer l'image d'un mail pour envoyer par mail [VBA]

Bonjour,

tous les matins je dois envoyer un mail en récupérant les infos de deux mails que je reçois tous les matins. Je voudrais automatiser ça. J'arrive a récupérer les deux mails et à les copier dans un mail.

Le problème est que dans un des mails il y a des images dans le corps du mail et je n'arrive pas à les récupérer, j'ai une croix rouge avec le message "impossible d'afficher l'image liée. Le fichier a peut-être été déplacé, renommé ou supprimé. Vérifiez que la liaison pointe vers le fichier et l'emplacement corrects."

Dans mes recherches je n'ai trouvé que le moyen de mettre un tableau excel dans le corps d'un mail ou une image de excel vers le mail mais pas la possibilité de passer une image d'un mail outlook reçus vers un autre mail à envoyer. La difficulté est aussi que les images sont en plein milieu du corps du mail et je voudrai garder la même structure. Je ne veux pas que les images soient au début ou à la fin du mail.

je fais ma macro sur excel car j'ai ma liste d'adresse email sur excel. La liste commence à la case A1

voici le code que j'ai

Sub ConnexionOutlook()

Dim co_outlookapp As Object
Dim co_olnomdomaine As Object
Dim co_oldossier As Object
Dim co_olmailitem As Object
Dim co_flgoutlook As Boolean
Dim co_orderinfo As String, co_orderinfo2 As Variant
Dim co_cheminfichier As String
Dim co_flgfic As Boolean
Dim bodymail As Variant

Dim OutApp As Object
Dim OutMail As Object

co_flgfic = True
co_flgoutlook = False
co_orderinfo = ""
co_orderinfo2 = ""
co_cheminfichier = ""

sujetmail1 = InputBox("Copiez le sujet du mail 1")
sujetmail2 = InputBox("Copiez le sujet du mail 2")

' Test de l'ouverture d'Outlook
Set co_outlookapp = CreateObject("Outlook.Application")
If co_outlookapp.Explorers.Count = 0 Then
    co_flgoutlook = True
End If

If co_flgfic Then
    'Permet l'accès aux données stockées Outlook de l'utilisateur
    Set co_olnomdomaine = co_outlookapp.GetNamespace("MAPI")
    'Indique quel dossier doit être traité, ici le dossier contenant les emails utiles de la boite de réception
    Set co_oldossier = co_olnomdomaine.GetDefaultFolder(olFolderInbox)
    'Boucle permettant de traiter tout les messages de la boite de réception
    For Each co_olmailitem In co_oldossier.Items

        On Error GoTo myend:

        'Si l'objet du mail et l'adresse de l'expéditeur corresponddent,
        If co_olmailitem.Subject = sujetmail1 Then
                'Et si le corps du message n'est pas vide
                If co_olmailitem.Body <> vbNullString Then
                   co_orderinfo = co_olmailitem.HTMLBody
                    'On fait appel à la procédure intégrant les informations dans le fichier Excel

                End If
        End If

myend:

        If co_olmailitem.Subject = sujetmail2 Then
            If co_olmailitem.Body <> vbNullString Then
                co_olmailitem.BodyFormat = olFormatHTML
                co_orderinfo2 = co_olmailitem.HTMLBody
            End If
        End If

    Next
End If

Call sendMail(co_orderinfo, co_orderinfo2)

'Si on avait lancé une instance Outlook on la ferme

'On décharge les objets en mémoire
Set co_oldossier = Nothing
Set co_olnomdomaine = Nothing
Set co_olmailitem = Nothing
Set co_outlookapp = Nothing
Set xl_app = Nothing
Set xl_book = Nothing

End Sub

Sub sendMail(co_orderinfo As String, co_orderinfo2 As Variant)

Dim Email As Outlook.Application
Dim EmailMsg As Outlook.MailItem
Dim Dest As Outlook.Recipient
Dim titre As String
Dim strbody As String

Set Email = CreateObject("Outlook.Application")
Set EmailMsg = Email.CreateItem(olMailItem)
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItem(olMailItem)

strbody = co_orderinfo & Chr(10) & Chr(10) & "++++++++++++++++++++++++++++++++++++++++++++++" & Chr(10) _
& Chr(10) & co_orderinfo2

If Range("A2").Value <> "" Then

    'on boucle pour ajouter des destinataires

    For i = 1 To Range(Range("A1"), Range("A1").End(xlDown)).Rows.Count
        Set Dest = EmailMsg.Recipients.Add(Cells(i, 1).Value)
            newDest = newDest & ";" & Dest
    Next i
Else

    Set Dest = EmailMsg.Recipients.Add(Range("A1").Value)

End If

EmailMsg.Subject = "test"
EmailMsg.HTMLBody = strbody
EmailMsg.To = newDest
EmailMsg.Display

End Sub

Merci