Fusionner plusieurs mail en 1 seul en VBA Outlook 2007

**d.tellier** · 30/12/2015, 23h55

Bonjour,
j'aimerais savoir comment faire pour fusionner plusieurs mails d'un dossier outlook dans une seul mail.

Merci.

**Oliv-** · 01/01/2016, 22h42

bonsoir,
c'est un peu léger comme explications,
tous les emails, ceux sélectionnés, les fusionner vers quoi un nouveau mail, avec les infos d'enveloppe ?

**d.tellier** · 02/01/2016, 15h12

Bonjour,
Je veux juste regrouper le contenu de plusieurs mail dans un nouveau mail.
Je n'ai pas besoin des infos du mail, expéditeur, etc....
Soit les mails sélectionner dans un dossier, ou tous les mails d'un dossier.

Merci.

**Oliv-** · 04/01/2016, 17h38

Bonjour,
Voici un exemple avec une selection de Mails en HTML

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
Sub FusiondeTouteLaSelection()
    Dim MonOutlook As Outlook.Application
    Dim Mail As Object
    Dim LeMail As Outlook.MailItem
    Dim MyNewMail As Outlook.MailItem
    Dim LesMails As Object
    Dim HTML As String
    Set MonOutlook = Outlook.Application
    Set LesMails = MonOutlook.ActiveExplorer.Selection
 
    For Each Mail In LesMails
        If Mail.Class = olMail Then
            Set LeMail = Mail
            If HTML = "" Then
                HTML = LeMail.HTMLBody
            Else
                HTML = HTML & "<br>" & LeMail.HTMLBody
            End If
 End If
        Next Mail
 
 
    Set MyNewMail = MonOutlook.CreateItem(olMailItem)
    MyNewMail.HTMLBody = HTML
    MyNewMail.Display
    Set LesMails = Nothing
    MsgBox "Opération terminée"
End Sub

**d.tellier** · 06/01/2016, 15h28

Bonjour,
Bonne année...

C'est exactement ça. Mais y aurait 'il un moyen d'avoir aussi les images contenu dans le mail?

Cordialement.

**Oliv-** · 06/01/2016, 22h41

bonsoir,

comme cela

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
41
42
43
Sub FusiondeTouteLaSelection()
    Dim MonOutlook As Outlook.Application
    Dim Mail As Object
    Dim LeMail As Outlook.MailItem
    Dim MyNewMail As Outlook.MailItem
    Dim LesMails As Object
    Dim HTML As String
    Dim objWordDocEditor
    Set MonOutlook = Outlook.Application
    Set LesMails = MonOutlook.ActiveExplorer.Selection
 
    Set MyNewMail = MonOutlook.CreateItem(olMailItem)
    Dim NewWordEditor
    MyNewMail.Display
    Set NewWordEditor = MyNewMail.GetInspector.WordEditor
 
    For Each Mail In LesMails
        If Mail.Class = olMail Then
            Set LeMail = Mail
 
            If LeMail.GetInspector.EditorType = olEditorWord Then
                'Word format email so try to copy with formatting
                'http://www.outlookcode.com/article.aspx?id=31
                'http://support.microsoft.com/kb/212682
                Set objWordDocEditor = LeMail.GetInspector.WordEditor
                objWordDocEditor.Range.Copy
                ' NewWordEditor.Range.Paste
                Set objSel = NewWordEditor.Windows(1).Selection
                objSel.Move wdStory, -1
                objSel.Move wdParagraph, 1
 
                objSel.Paste    'AndFormat (wdPasteDefault)
 
            End If
 
        End If
    Next Mail
 
 
 
    Set LesMails = Nothing
    MsgBox "Opération terminée"
End Sub

**d.tellier** · 07/01/2016, 15h22

Bonjour,
Merci pour commencer.
Quand je lance la macro j'ai une erreur la fenêtre VB s'ouvre en jaune sur la ligne :

objSel.Move wdStory, -1

Cordialement.

**Oliv-** · 08/01/2016, 11h08

Bonjour essaye en ajoutant AVANT

Code :

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

ON ERROR RESUME NEXT

edit: Tu peux lire cet article sur l'utilisation de WORDEDITOR = équivalent de WORD

https://msdn.microsoft.com/en-us/lib...singWordEditor

**d.tellier** · 08/01/2016, 13h26

Bonjour,
et merci.
Je n'arrive pas à mettre une ligne de séparation entre les mails.

Merci.

**Oliv-** · 08/01/2016, 14h36

en fait tu peux utiliser enregistreur de macro de WORD pour trouver la syntaxe

Selection.InlineShapes.AddHorizontalLineStandard

te donne

objSel.InlineShapes.AddHorizontalLineStandard

puisque objSel est un objet SELECTION

ajoute la ligne du milieu entre les 2 autres.

Code :

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

1
2
3
          objSel.Move wdParagraph, 1
                    objSel.InlineShapes.AddHorizontalLineStandard
                    objSel.Paste    'AndFormat (wdPasteDefault)

**d.tellier** · 10/01/2016, 19h11

Bonjour,
Deux question.
1) Le VB faut-il le mettre dans un module ou dans Thisoutllooksession.
Si je le met dans ThisOutllooksession ou j'ai déjà des vb et j'ai comme première ligne : Option Explicit
Quand je lance la macro elle se break sur : Set objsel = NewWordEditor.Windows(1).Selection (en jaune) et voila le message d'erreur (erreur de compilation - Variable non définie)

2) je voulais ajouter un séparateur de ligne et un compteur de mail comme séparateur

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
 
Numero = 1                                                                                     ' Ligne ajoutée
 
    For Each Mail In LesMails
        If Mail.Class = olMail Then
            Set LeMail = Mail
 
            If LeMail.GetInspector.EditorType = olEditorWord Then
                'Word format email so try to copy with formatting
                'http://www.outlookcode.com/article.aspx?id=31
                'http://support.microsoft.com/kb/212682
                Set objWordDocEditor = LeMail.GetInspector.WordEditor
                objWordDocEditor.Range.Copy
                ' NewWordEditor.Range.Paste
                Set objsel = NewWordEditor.Windows(1).Selection
 
                objsel.Move wdStory, -1
 
' ligne ajoutée
                objsel.TypeText Text:= _                                              
                vbCrLf & "-----------------------------------------------------------------------  New  Mail N°" _
                & Numero & "------------------------------------------------------------------------------------------" & vbCrLf
' Fin de ligne ajoutée
 
               objsel.Move wdParagraph, 1
               objsel.Paste    'AndFormat (wdPasteDefault)
 
            End If
 
        End If
        Numero = Numero + 1                    ' ajout de ligne
    Next Mail

Quand je lance la macro et que j'ai sélectionné 4 mails. Dans le nouveau mail crée il n'y a que 3 mails. Et quand je relance la macro cette fois ci c'est vide. Il faut que j'éteigne Outlook pour relancer la macro
partiellement correcte.

merci pour ta réponse.

Cordialement Dominique

**Oliv-** · 11/01/2016, 10h28

Bonjour,

1) dans un module c'est très bien. Tu peux déclarer les variables non déclarées par un simple Dim NomVariable.

2) chez moi en ajoutant tes lignes dans MON code cela fonctionne correctement, cela doit venir de la déclaration de tes variables, il faudrait que tu publies l'ensemble du code.

**d.tellier** · 12/01/2016, 00h15

Bonsoir,
Le voici.
Je developpe un peu en VBA excel.Mais le VBA outlook je n'y comprend rien.
merci pour ton aide.

Option Explicit

Sub FusiondeTouteLaSelection()
On Error Resume Next
Dim MonOutlook As Outlook.Application
Dim Mail As Object
Dim LeMail As Outlook.MailItem
Dim MyNewMail As Outlook.MailItem
Dim LesMails As Object
Dim HTML As String
Dim Numero As Integer
Dim objWordDocEditor
Set MonOutlook = Outlook.Application
Set LesMails = MonOutlook.ActiveExplorer.Selection

Set MyNewMail = MonOutlook.CreateItem(olMailItem)
Dim NewWordEditor
MyNewMail.Display
Set NewWordEditor = MyNewMail.GetInspector.WordEditor
Numero = 1
For Each Mail In LesMails
If Mail.Class = olMail Then
Set LeMail = Mail

If LeMail.GetInspector.EditorType = olEditorWord Then
'Word format email so try to copy with formatting
'http://www.outlookcode.com/article.aspx?id=31
'http://support.microsoft.com/kb/212682
Set objWordDocEditor = LeMail.GetInspector.WordEditor
objWordDocEditor.Range.Copy
' NewWordEditor.Range.Paste
Set objsel = NewWordEditor.Windows(1).Selection

objsel.Move wdStory, -1

objsel.TypeText Text:= _
vbCrLf & "----------------------------------------------------------------------- New Mail N°" _
& Numero & "------------------------------------------------------------------------------------------" & vbCrLf

objsel.Move wdParagraph, 1
objsel.Paste 'AndFormat (wdPasteDefault)

End If

End If
Numero = Numero + 1
Next Mail

Set LesMails = Nothing
MsgBox "Opération terminée"
End Sub

Cordialement.

**Oliv-** · 12/01/2016, 14h31

Bonjour,
Ce code doit fonctionner !
Il ignore toutefois les éléments qui ne sont pas des EMAILS.

**d.tellier** · 19/01/2016, 00h10

Bonjour,
je ne comprend pas car je le teste sur un dossier ou je n'ai que des mails (des newsletters) et assez souvent j'ai un mail vide.
il ne me remonte rien.

As tu une autre solution. car celle la n'est pas génial.

merci.

**Oliv-** · 20/01/2016, 10h53

Bonjour,
Il faut bien sûr sélectionner tous les mails souhaités avant !
Dans quel cas cela ne fonctionne t'il pas ?
Tu peux suivre le déroulement en mode pas à pas en lançant avec F8 dans VBE.

Fusionner plusieurs mail en 1 seul en VBA Outlook 2007

VBA Outlook

Discussions similaires

Partager

Partager