Discussion :

[Jwinner]

Bonjour à tous,
je suis nouveau sur ce site. j'aimerais avoir votre aide au sujet d'une macro que je souhaite mettre en place sous outlook2013.
je vous explique le contexte:

j'occupe actuellement un poste ou je dois effectuer des relances auprès des responsables de projet (environ 200 personnes) chaque mois afin qu'ils fassent valider sous un logiciel interne le relevé d'activités du mois de leurs collaborateurs. Au début du mois suivant, je fais une extraction sous excel (via le logiciel interne/ Voir fichier exemple: Extetat) d'un état récapitulatif des relevés non validés et je commence à relancer des responsables de projet.

j'ai crée à partir de l'extraction excel une macro qui crée (dans un dossier nommé PJ) un fichier excel par responsable présentant l'état de ses collaborateurs n'ayant pas validés leurs relevés (voir fichier exple : responsabe3@gmail.com).

Utilisant le publipostage d'un fichier Word contenant mon message type, lorsque je clique sur "envoyer des messages électronique", je souhaite crée sous Outlook une macro qui va joindre le fichier excel correspondant à l'adresse du destinataire se trouvant dans mon dossier PJ.

Ce que j'ai déjà fait:

Sous VBA dans "Thisoutlooksession" j'ai écrit le code suivant:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim objCurrentMessage As MailItem
    Dim i As Long
    Set objCurrentMessage = Item
 
    If Item.Class = olMail Then
                objCurrentMessage.Attachments.Add Source:="C:\PJ\responsable3@gmail.com.xlsx"
                objCurrentMessage.Subject = "Relance RA"
                objCurrentMessage.Save
    End If
 
    Set objCurrentMessage = Nothing
 
End Sub

Seulement voila, ce code envoie au "responsable3" le fichier Excel nommé "responsable3@gmail.com" lui correspondant. et Moi j'aimerais utiliser une boucle ou quelque chose du genre pour qu'il envoie au 200 responsables.

Merci pour vos nombreuses propositions.

Jwinner

[Oliv-]

bonjour
regarde ici

[Jwinner]

Merci oliv mais après lecture de la page que tu m'as conseillé, j'ai essayé la macro pour une PJ identique pour chaque responsable : ça marche !!

PAR CONTRE pour mon objectif qui est de joindre le fichier excel correspondant au mail de chaque responsable sa ne marche pas. j'ai joint à mon message le code que j'ai utilisé ainsi que des imprim écran des erreurs...
Dans l'attente d'une réponse.

Cordialement,

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
Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)
 
Dim prompt As String
    Dim taille, pieces
    Dim objNS As NameSpace
    Dim objFolder As MAPIFolder
 
    ' on verifie que c'est un mail
    If Not item.Class = olMail Then GoTo fin
 
    If UCase(item.Subject) Like "*TEST *" Then
        'On Error Resume Next
        'Pour ajouter la même PJ à tous
        'item.Attachments.Add "C:\TEST VBA\PJ\amanyserge@gmail.com.xlsx"
 
 'Pour ajouter un document personnalisé d'après le destinataire _
         du mail décommenter
        ' ici le nom du document est "destinataire@domaine.fr.doc"
        docperso = "C:\TEST VBA\PJ\" & item.To & ".xlsx"
        item.Attachments.Add Source:=docperso
 
        'On sauvegarde le mail
        item.Save
        'on va directement à la fin pour éviter les questions sur l'envoi
        GoTo fin
    End If
 
    '#######FIN #######
fin:
 
    Set item = Nothing
 
End Sub

[Oliv-]

est ce avec exchange ?

ajoutes un

Code :

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

msgbox item.To

est ce bien une des adresses Email que tu attends ?

[Jwinner]

Voici le code que j'ai exécuté:

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
Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)
 
Dim prompt As String
    Dim taille, pieces
    Dim objNS As NameSpace
    Dim objFolder As MAPIFolder
 
    ' on verifie que c'est un mail
    If Not item.Class = olMail Then GoTo fin
 
    If UCase(item.Subject) Like "*TEST *" Then
    MsgBox item.To
 
    End If
 
    '#######FIN #######
fin:
 
    Set item = Nothing

Pour répondre à ta question: oui c'est bien les adresses que je souhaite qui apparaissent chacune à son tour dans une boite de dialogue.

Donc le item.to récupère l'adresse du destinataire à chaque fois et l'affiche dans une boite de dialogue? C'est bien ça ?

que dois je faire ensuite?

J'ai mis en pièce jointe une exemple de ce qui s'est affiché.

End Sub

[Jwinner]

le code ci-dessous fonctionne à merveille quand je l'utilise de mon adresse personnelle ".xxxx@gmail.com" mais une fois que j'utilise le même code sur mon poste de travail du boulot et mon adresse professionnelle .. IL NE FONCTIONNE PLUS quelqu'un peut il m'expliquer????

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
Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)
Dim prompt As String
    Dim taille, pieces
    Dim objNS As NameSpace
    Dim objFolder As MAPIFolder
 
    ' on verifie que c'est un mail
    If Not item.Class = olMail Then
 
    GoTo fin
 
    Else
    item.Attachments.Add "C:\TEST VBA\PJ\" & item.To & ".xlsx"
    item.Subject = "RA"
    item.Save
        'on va directement à la fin pour éviter les questions sur l'envoi
    GoTo fin
 
    End If
 
 
    '#######FIN #######
fin:
 
    Set item = Nothing
 
End Sub

Cordialement!

[Oliv-]

marche pas c'est à dire ? le code de s'exécute pas , la pj n'est pas ajoutée ?

est ce que "C:\TEST VBA\PJ\" & item.To & ".xlsx" existe bien sur ce poste ?

[Jwinner]

OLIV

Voici le code entré dans le outlook de mon pc pro:

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
Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)
 
 
    'Déclaration des variables
Dim prompt As String
Dim taille, pieces
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
 
 
 
                    ' on verifie que c'est un mail
 
If item.Class = olMail Then
 
item.Subject = "RA"
 
item.Attachments.Add Source:="X:\Relevés\PJ\" & item.To & ".xlsx"
 
item.Save
                    'on va directement à la fin pour éviter les questions sur l'envoi
GoTo fin
 
End If
 
 
                    '#######FIN #######
fin:
 
Set item = Nothing
 
End Sub

Le code s'éxecute et se bloque au niveau de l'ajout de la pièce jointe, il m'affiche erreur 446 quand je clique sur débogage il me surligne en jaune la ligne de code suivante :

Code :

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

item.Attachments.Add Source:="X:\Relevés\PJ\" & item.To & ".xlsx"

[Oliv-]

essaye avec ca

Code :

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

item.Attachments.Add "X:\Relevés\PJ\" & item.To & ".xlsx"

[Jwinner]

Oliv merciii pour cette ligne de code!

Je l'ai essayé à partir de mon adresse mail pro que je vais appeler ici " gggg@xyz.com ", elle fonctionne parfaitement ( C a d que le mail part avec la pièce jointe)

mais uniquement pour les mails que j'ai envoyé à des collaborateurs sur leurs boites mails personnelles ( @gmail.com/ @hotmail.fr/ @yahoo.Fr/ etc.....)

les autres mails envoyés sur des boites mails professionnelles (...@xyz.com) partent sans la pièce jointe

JE COMPRENDS PLUS RIEN.

[Oliv-]

Bonjour,
Pour mieux comprendre ton problème est ce les mêmes versions de OFFICE ENTRE TON PC PRO ET PERSO ?

Il faut que tu utilises le mode pas à pas F8 où que tu mettes un point d'arrêt (cliques dans le colonne à gauche de l'instruction o^tu veux ton arrêt) ou un espion;

un peu de lecture (c'est pareil pour outlook)
http://cafeine.developpez.com/access...el/debugprint/
http://www.tomshardware.fr/forum/id-...-debogage.html


Le problème qu'il peut y avoir si tu as un serveur EXCHANGE c'est que le l'adresse de messagerie n'est pas toto@masociete.com mais un truc
Address = "/o=ExchangeLabs/ou=Exchange Administrative Group (FYDI23SPDLT)/cn=Recipients/cn=cfeadd194d0e41b5abe4e6bf3"

Donc ton .TO renvoit souvent "prénom nom", mais aussi "prénom nom,prénom2 nom2" si tu as plusieurs destinataires dans ce mail.

donc ton association email/FICHIER EST KO

il faut utiliser les objets recipients (destinataires)

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
Sub test_adresse_SMTP_DESTINATAIRES()
    Set OITEM = ActiveInspector.CurrentItem    'désigne l'élément actif càd le mail le contact ou rdv...
   Dim dest As Recipient
For Each dest In OITEM.Recipients
 
    MsgBox dest.name & vbcr & dest.Address & vbCr & GetSMTPAddressForRecipient(dest)
Next dest
 
End Sub
 
Function GetSMTPAddressForRecipient(recip As Outlook.Recipient) As String
'---------------------------------------------------------------------------------------
' Procedure : GetSMTPAddressForRecipient
' Author    : Oliv-
' Date      : 21/01/2015
' Purpose   : Obtenir l'adresse SMTP =xxx@xxx.xxx
'---------------------------------------------------------------------------------------
'
'Dim recip As Outlook.Recipient
'pas de adresse SMTP si Contact d'origine EXCHANGE mais copié dans Pop
GetSMTPAddressForRecipient = ""
On Error GoTo fin
    Dim pa As Outlook.PropertyAccessor
    Const PR_SMTP_ADDRESS As String = _
          "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    Set pa = recip.PropertyAccessor
    'Debug.Print recip.Name & " SMTP=" _
                & pa.GetProperty(PR_SMTP_ADDRESS)
    GetSMTPAddressForRecipient = pa.GetProperty(PR_SMTP_ADDRESS)
fin:
 
End Function