Insertion une ou des images dans mail

**webosama80** · 05/03/2014, 16h58

Bonjour à tous,

Je vous explique mon cas, j'ai une macro qui me permet de réaliser une capture d'écran d'un logiciel spécifique que j'utilise tous les jours (macro qui marche pour powerpoint, word, excel avec l'insertion de l'image dans le document) et je souhaiterais la même chose pour Outlook.

Mon problème est que je ne sais pas comment faire en vb une insertion d'une ou plusieurs images lorsque qu’un nouveau message est créé sans passer par le menu du ruban "insertion/image" du message (du style insertion de C:\temp\scr-008.jpg et C:\temp\scr-007.jpg)

Je précise que je ne souhaite pas créer un nouveau mail avec la macro, je souhaite insérer le ou les images depuis un nouveau message créé.

Merci à vous.

**Oliv-** · 06/03/2014, 10h11

Bonjour, Voici un exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Private Sub Active_mail_with_embedded()
'---------------------------------------------------------------------------------------
' Procedure : Active_mail_with_embedded
' Author    : octu
' Date      : 06/03/2014
' Purpose   : Ajout d'une pj incorporée au corps de l'Email
' Compatibility : OL2010
'---------------------------------------------------------------------------------------
    Dim MaPj As String
    MaPj = "U:\largeVLC.jpg"
 
    Dim StrEntryID As String
    Dim objOL As Outlook.Application
    Dim objMail As MailItem
    Dim EmbAtt As Attachment
    Set objOL = CreateObject("Outlook.Application")
    Set objMail = objOL.ActiveInspector.CurrentItem
    Set EmbAtt = objMail.Attachments.add(MaPj)
 
 
    If MsgBox("Oui pour remplacer tout, non pour rempalcer CID: par l'image", vbYesNo) = vbYes Then
        objMail.HTMLBody = "<html><p>This is a picture.</p>" & _
                           "<img src='cid:" & EmbAtt.DisplayName & "' ></html>"
    Else
 
        If InStr(1, objMail.Body, "CID:") > 0 Then
            objMail.HTMLBody = Replace(objMail.HTMLBody, "CID:", "<img src='cid:" & EmbAtt.DisplayName & "' >")
        Else
            objMail.HTMLBody = Replace(objMail.HTMLBody, "<div class=WordSection1>", "<div class=WordSection1><img src='cid:" & EmbAtt.DisplayName & "' >")
 
        End If
    End If
    'objMail.Close olSave
    StrEntryID = objMail.EntryID
    Set objMail = Nothing
    'Set objMail = objOL.GetNamespace("MAPI").GetItemFromID(strEntryID)
    'objMail.Display
End Sub

**webosama80** · 26/03/2014, 14h11

Je te remercie pour cette macro, cela fonctionne, mais l'option de mettre en pièce jointe ne me sert à rien dans mon cas, j'ai réussi à pondre une autre macro dont voici le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test2()
 
Set Courrier = ActiveInspector.CurrentItem
Select Case Courrier.BodyFormat
    Case olFormatHTML:
    OuCommenceAdresse = InStr(1, Courrier.HTMLBody, "<BODY", vbTextCompare)
        If OuCommenceAdresse > 0 Then
            fin = InStr(OuCommenceAdresse + 5, Courrier.HTMLBody, ">") + 1
            BaliseBody = Mid(Courrier.HTMLBody, OuCommenceAdresse, fin - OuCommenceAdresse)
            Courrier.HTMLBody = Replace(Courrier.HTMLBody, BaliseBody, "<img src='C:\temp\snapshot.jpeg' height=390 width=720>" & "<BR>", 1, 1, vbTextCompare)
        End If
End Select
 
End Sub

Par contre je souhaiterais désormais remplacer, sur l'image que je viens d'insérer, le texte de remplacement (AlternativeText) par un autre texte du genre "mon texte de remplacement" tout en gardant l'image biensur.

Une idée ?

**Oliv-** · 26/03/2014, 14h43

Envoyé par webosama80

Je te remercie pour cette macro, cela fonctionne, mais l'option de mettre en pièce jointe ne me sert à rien dans mon cas

bonjour,
Je ne comprends pas ta remarque ?

Effectivement ton code fait le job, ca n'était pas le cas avec des versions plus anciennes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

   Courrier.HTMLBody = Replace(Courrier.HTMLBody, BaliseBody, "<img src='C:\temp\snapshot.jpeg' height=390 width=720>" & "<BR>", 1, 1, vbTextCompare)

Sinon pour répondre à ta dernière question cela se passe dans le code html

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

<img width=400 height=300 id="Image_x0020_1" src="cid:image001.jpg@01CF4900.ED447CF0" alt="Titre&nbsp;: toto im - Description&nbsp;: cid:largeVLC.jpg">

soit tu as la propriété alt dans la balise <IMG> et tu dois la modifier, soit tu dois l'ajouter

**webosama80** · 26/03/2014, 15h00

Pour la remarque c'était seulement car dans certains cas cela me mettais en pièce jointe mon image.
bref pas grave pour ça.

Par contre j'ai suivi ton idée sur modifier le alt de l'image comme ci-joint:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Set Courrier = ActiveInspector.CurrentItem
Select Case Courrier.BodyFormat
    Case olFormatHTML:
    OuCommenceAdresse = InStr(1, Courrier.HTMLBody, "<BODY", vbTextCompare)
        If OuCommenceAdresse > 0 Then
            fin = InStr(OuCommenceAdresse + 5, Courrier.HTMLBody, ">") + 1
            BaliseBody = Mid(Courrier.HTMLBody, OuCommenceAdresse, fin - OuCommenceAdresse)
            Courrier.HTMLBody = Replace(Courrier.HTMLBody, BaliseBody, _
            "<img src='C:\temp\snapshot.jpeg' height=390 width=720 alt='mon texte de remplacement'>" & "<BR>", 1, 1, vbTextCompare)
        End If
End Select

Cela me change bien le texte alternatif de l'image par celui que je demande "mon texte de remplacement", cool pour ça, mais maintenant pour aller plus loin encore je souhaiterais que ce texte alternatif ne soit pas un texte que je marque à la main , ici 'mon texte de remplacement', mais plutôt des valeurs d'une variable que j'ai déclaré avant.

La valeur c'est plutôt

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Dim ViewPointInfoTxt
ViewPointInfoTxt = origin(0) & "/" & origin(1) & "/" & origin(2) _
& "/" & sight(0) & "/" & sight(1) & "/" & sight(2) _
& "/" & up(0) & "/" & up(1) & "/" & up(2) _
& "/" & Myfield & "/" & Myfocus & "/" & Myzoom & "/" & ProjeMode & "/" & RenderMode

Recap : remplacer "mon texte de remplacement" par la valeur "ViewPointInfoTxt"

Une idée ?

**pc75** · 27/03/2014, 08h56

Bonjour,

Peut-être ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Dim ViewPointInfoTxt
ViewPointInfoTxt = origin(0) & "/" & origin(1) & "/" & origin(2) _
& "/" & sight(0) & "/" & sight(1) & "/" & sight(2) _
& "/" & up(0) & "/" & up(1) & "/" & up(2) _
& "/" & Myfield & "/" & Myfocus & "/" & Myzoom & "/" & ProjeMode & "/" & RenderMode
 
Set Courrier = ActiveInspector.CurrentItem
Select Case Courrier.BodyFormat
    Case olFormatHTML:
    OuCommenceAdresse = InStr(1, Courrier.HTMLBody, "<BODY", vbTextCompare)
        If OuCommenceAdresse > 0 Then
            fin = InStr(OuCommenceAdresse + 5, Courrier.HTMLBody, ">") + 1
            BaliseBody = Mid(Courrier.HTMLBody, OuCommenceAdresse, fin - OuCommenceAdresse)
            Courrier.HTMLBody = Replace(Courrier.HTMLBody, BaliseBody, _
            "<img src='C:\temp\snapshot.jpeg' height=390 width=720 alt='" & ViewPointInfoTxt & "'>" & "<BR>", 1, 1, vbTextCompare)
        End If
End Select

**webosama80** · 27/03/2014, 09h56

merci beaucoup pour l'info,cela marche bien pour le texte alternatif.

Je souhaiterais encore ajouter une option dans ma macro, je m'explique : ma macro fait une capture d'écran du logiciel à coté, et l'image est stockée avec une variable que j'ai nommé "ADR" et qui est stockée sous : "C:\temp\snapshot.jpg", j'ai changé dans la macro l'adresse de l'image par ADR, mais lorsque je veux insèrer plusieurs captures différentes cela me mets toujours la même image (même si celle-ci n'exsite pas sur mon disque)
Voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Dim ViewPointInfoTxt
ViewPointInfoTxt = origin(0) & "/" & origin(1) & "/" & origin(2) _
& "/" & sight(0) & "/" & sight(1) & "/" & sight(2) _
& "/" & up(0) & "/" & up(1) & "/" & up(2) _
& "/" & Myfield & "/" & Myfocus & "/" & Myzoom & "/" & ProjeMode & "/" & RenderMode
 
Dim ADR As String
ADR = "C:\temp\snapshot.jpg"
 
Set Courrier = ActiveInspector.CurrentItem
Select Case Courrier.BodyFormat
    Case olFormatHTML:
    OuCommenceAdresse = InStr(1, Courrier.HTMLBody, "<BODY", vbTextCompare)
        If OuCommenceAdresse > 0 Then
            fin = InStr(OuCommenceAdresse + 5, Courrier.HTMLBody, ">") + 1
            BaliseBody = Mid(Courrier.HTMLBody, OuCommenceAdresse, fin - OuCommenceAdresse)
            Courrier.HTMLBody = Replace(Courrier.HTMLBody, BaliseBody, _
            "<img src='" & ADR & "' height=390 width=720 alt='" & ViewPointInfoTxt & "'>" & "<BR>", 1, 1, vbTextCompare)
        End If
End Select
 
Kill (ADR)

une idée ?

**pc75** · 27/03/2014, 10h16

Re,

Tu es sur que le Kill détruit bien ton fichier ?

**webosama80** · 27/03/2014, 10h17

Oui tout à fait !

**Oliv-** · 27/03/2014, 10h54

SAlut,
c'est sans doute dans le cache de IE.
revoir la première méthode

**webosama80** · 27/03/2014, 13h16

C'est pareil meme avec la première méthode.

Comment supprimer aussi l'image du cache IE du coup en plus du "Kill (ADR)" ?

**Oliv-** · 27/03/2014, 15h13

Envoyé par webosama80

mais lorsque je veux insèrer plusieurs captures différentes cela me mets toujours la même image (même si celle-ci n'exsite pas sur mon disque)

tu veux insérer plusieurs images dans ton Email ou créer plusieurs Emails avec une nouvelle photo ?
comment regèneres tu l'image ?

**webosama80** · 27/03/2014, 15h23

Je veux insérer plusieurs images dans un seul et même mail.

je capture l'image à partir du code que je fais juste avant avec :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
'-----Capture d'image
MyViewer.CaptureToFile catCaptureFormatJPEG, ADR

Avec la suite :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Dim ADR As String
ADR = "C:\temp\snapshot.jpg"
.........

**Oliv-** · 27/03/2014, 16h05

Difficicle de comprendre avec des morceaux de code !!!

ce que je comprends c'est que ton

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MyViewer.CaptureToFile catCaptureFormatJPEG, ADR

génére une image, que tu écrases lorsque la boucle repasse dessus.

donc tu ne peux avoir que la dernière image générée non ?

Pourquoi ne généres tu pas tes images dans un dossier c:\temp\Myviewer\
en les nommant snapshot_1.jpg, snapshot_2.jpg,snapshot_N.jpg...

et tu boucles sur ton dossier avec FSO pour prendre toutes les images.
tu concatènes un code html correct et tu remplaces le bodyhtml par cela...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
MonDossierPJ = "c:\temp\Myviewer\"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set AFolder = Fso.GetFolder(MonDossierPJ)
             Set TheFiles = AFolder.Files
            On Error Resume Next
            For Each Afile In TheFiles
                Courrier.Attachments.Add Source:=Afile.Path
monhtml=monhtml & "<img src='" & Afile & "' height=390 width=720 alt='" & ViewPointInfoTxt & "'>" & "<BR>"
            Next Afile

à la fin tu effaces tous les fichiers du dossier temporaire
ps j'ai pas testé

**webosama80** · 27/03/2014, 16h24

Alors je vais un peu développer mon idée :
j'ai fait pour Excel, Powerpoint, et Word, un ruban personnalisé sur chaque programme, avec un bouton (qui lance une macro bien-sur) spécial "Capture d'écran" d'un logiciel bien spécifique, et cela marche nickel.
Mais sur Outlook, déjà je galère pour pouvoir faire un ruban dans mon nouveau mail créé, et puis je veux avoir le même principe, sauf que le code n'est pas exactement le même.
La j'y suis presque, sauf le problème d'image qui n'est pas la bonne.
L'image générée sur C:\temp\ n'est que temporaire et je ne veux rien garder, aucune utilité puisqu'elle est stocké dans les divers documents.

Et puis donc ce futur bouton dans un nouveau mail via un ruban, servira à réalisé la capture d'écran à l'instant T, et puis refaire une autre photo.

Juste une indication par exemple sur ma macro Powerpoint :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
'-----Insertion de l'image dans powerpoint
ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:=ADR, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=0, Top:=100, Width:=720, Height:=390).Select
 
'-----Insertion des paramètres de prise de vue
ActiveWindow.Selection.ShapeRange.AlternativeText = ViewPointInfoTxt
 
'-----Remplacement du . par une , dans le paramètre du point de vue
ActiveWindow.Selection.ShapeRange.AlternativeText = Replace(ActiveWindow.Selection. _
ShapeRange.AlternativeText, ".", ",")
 
'-----Efface le fichier temporaire
Kill (ADR)

avec comme je disais précédement : ADR pour la photo temporaire, et ViewPointInfoTxt pour le texte alternatif

J'espère avoir été assez clair dans ce que je dis !!

**Oliv-** · 27/03/2014, 18h45

Tout Cela je l'avais compris
Ce que je ne comprend pas c est combien de fois tu insères une photo
Est ce x fois , 1x quand tu cliques sur ton bouton etc

**webosama80** · 28/03/2014, 07h23

1 clique sur le bouton = 1 screenshot

et j'en insère autant de fois que je veux, à chaque clique ça prend le photo de mon autre logiciel.

**Oliv-** · 28/03/2014, 10h46

Salut,
Voilà une explication claire !

Alors d'une part il y avait un problème dans ton code , il manquait BaliseBody, en fait on ne remplace pas vraiment mais on insère donc il faut remettre la balise

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Courrier.HTMLBody = Replace(Courrier.HTMLBody, BaliseBody, _
             BaliseBody & "<img src='" & ADR & "' height=390 width=720 alt='" & ViewPointInfoTxt & "'>" & "<BR>", 1, 1, vbTextCompare)

D'autre part, outlook ne permet pas de mettre dans le corps du mail (en vba) plusieurs images ayant le même nom, si tu fait manuellement la tache tu verras dans la source du Mail qu'outlook attribu des noms image001, image002 etc...

J'ai déplacé aussi l'insertion au lieu de mettre l'image au début du mail je l'a met à la fin.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub test28032014()
Dim ViewPointInfoTxt
Set FSO = CreateObject("Scripting.FileSystemObject")
 
 
 
ViewPointInfoTxt = origin(0) & "/" & origin(1) & "/" & origin(2) _
& "/" & sight(0) & "/" & sight(1) & "/" & sight(2) _
& "/" & up(0) & "/" & up(1) & "/" & up(2) _
& "/" & Myfield & "/" & Myfocus & "/" & Myzoom & "/" & ProjeMode & "/" & RenderMode
 
Dim ADR As String
ADR = "C:\temp\snapshot.jpg"
 
Set Courrier = ActiveInspector.CurrentItem
 
NbPJ = Courrier.Attachments.Count
 
If NbPJ > 0 Then
Set Afile = FSO.GetFile(ADR)
Afile.Name = Replace(Afile.Name, "snapshot", "snapshot" & CStr(NbPJ))
ADR = Afile.path
End If
Dim EmbAtt As Attachment
Set EmbAtt = Courrier.Attachments.add(ADR)
 
 
Select Case Courrier.BodyFormat
    Case olFormatHTML:
    OuCommenceAdresse = InStr(1, Courrier.HTMLBody, "</body", vbTextCompare)
        If OuCommenceAdresse > 0 Then
            fin = InStr(OuCommenceAdresse + 5, Courrier.HTMLBody, ">") + 1
            BaliseBody = Mid(Courrier.HTMLBody, OuCommenceAdresse, fin - OuCommenceAdresse)
            Courrier.HTMLBody = Replace(Courrier.HTMLBody, BaliseBody, _
             "<img src='cid:" & EmbAtt.FileName & "' height=390 width=720 alt='" & ViewPointInfoTxt & "'>" & "<BR>", 1, 1, vbTextCompare) & BaliseBody
        End If
End Select
Courrier.Save
Kill (ADR)
End Sub

**webosama80** · 28/03/2014, 11h10

Et bé c'est super ce que tu m'a dis, ça marche nickel, la photo se remplace, je te remercie.

Par contre je souhaiterais vraiment avoir la photo ou j'ai ma souris d'active (signature mail intégrée oblige ! lol), comment faire, je vois pas comment !

**Oliv-** · 28/03/2014, 11h25

2 possibilités
au lieu de chercher la balise </body> tu peux rechercher le premier mot de ta signature

utiliser les fonctions "word"
que je n'utilise pas alors fait une recherche sur WordEditor

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

'ActiveInspector.WordEditor.Application.Selection.TypeText "Fait pour vérification" & vbNewLine

Insertion une ou des images dans mail [OL-2007]

VBA Outlook

Discussions similaires

Partager

Partager