VBA OUTLOOK: Insertion d'une deuxième pièce jointe

**LANGAZOU** · 09/05/2015, 14h19

Bonjour,

J'utilise une macro sous Excel qui détecte le mail sélectionné sous OUTLOOK et effectue par la suite une réponse automatique en mettant en pièce jointe un document Word . si cette macro se lance par erreur deux fois de suite un msg box s’affiche en signalant que le mail est déjà prêt à l'envoi sans avoir exécuter le reste du module.

Ma question est que y'a t-il un moyen que lorsque j'active ma macro deux fois de suite (C'est à dire après avoir créer le mail avec corps et pièce jointe) il insère uniquement une deuxième pièce jointe après avoir afficher le msgbox "Mail deja ouvert et prêt à l'envoi " ? ci-dessous un extrait de ma macro:

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
Dim objApp As Object
Dim MailOutLook As Object
Dim rep_fic As String
Dim strbody As String
 
Set objApp = CreateObject("Outlook.Application")
 
On Error Resume Next
    Set ObjCurrentMessage = GetCurrentItem
    If ObjCurrentMessage Is Nothing Or ObjCurrentMessage.sent = False Then
        MsgBox "Mail deja ouvert et prêt à l'envoi"
        Exit Sub
    End If
    On Error GoTo 0
 
Set MailOutLook = ObjCurrentMessage.ReplyAll
 
 
rep_fic = pièce jointe
 
 
strbody = "<BODY style=font-size:12pt;font-family:Calibri>Bonjour,<p>Veuillez trouver ci-joint notre facture.<p>Bonne réception.</BODY>"
 
With MailOutLook
 
.Display
.Subject = "Facture"
.Recipients.ResolveAll
.HTMLBody = strbody & "<br>" & .HTMLBody
.Attachments.Add rep_fic
.Display
 
End With
 
Set MailOutLook = Nothing
Set appOutLook = Nothing

Merci pour votre aide.

**Oliv-** · 10/05/2015, 19h50

Salut
J ai pas bien compris le pb mais pour ajouter une 2 eme pj il suffit d ajouter une ligne équivalente
.Attachments.Add rep_fic

**LANGAZOU** · 10/05/2015, 21h40

Bonjour Oliv-,

c'est bon j'ai fait les Modif suivantes et ca marche très bien.

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
rep_fic = sDossier & sOut
 
 
On Error Resume Next
    Set ObjCurrentMessage = GetCurrentItem
    If ObjCurrentMessage Is Nothing Then
        MsgBox "Merci d'ouvrir OUTLOOK"
        Exit Sub
    End If
    On Error GoTo 0
 
On Error Resume Next
    Set ObjCurrentMessage = GetCurrentItem
    If ObjCurrentMessage.sent = False Then
        MsgBox "File Added"
        ObjCurrentMessage.Attachments.Add rep_fic
        Exit Sub
    End If
    On Error GoTo 0

Merci pour votre intervention et bonne journée.

VBA OUTLOOK: Insertion d'une deuxième pièce jointe

VBA Outlook

Discussions similaires

Partager

Partager