[résolu] Macro de publipostage et envoie de mail

[white-angel]

Bonsoir,

Je tiens à préciser avant d'exposer mon problème, que j'ai fais des recherches (2 semaines) et des tests mais en vain.

Je m'explique.
J'ai une macro sous word qui me créer mon publipostage, et qui envoie automatiquement à plusieurs contacts différents ce publipostage. (4 contacts par mails, et 200 mails)
La macro fonctionne très bien. Elle envoie le tout chez Outlook qui me rajoute une PJ en fonction du client. C'est parfait. OUI MAIS : Outlook2007 ne me pose aucun problème, mais Outlook 2003 m'affiche le message tant connu : Un programme tente d'envoyer un mail en votre nom. (je ne vous remet pas le message entier, j'ai vu que le problème était bien connu.)
Je n'arrive cependant pas à trouver le code qui me permet d'éviter ce message (que ce soit Word ou Outlook qui me le "supprime")
J'ai vu une méthode sendkey. Mais je ne vois pas bien ou la placer.
Je ne peux pas utiliser ClickYes de quelque facon que ce soit.

Si vous avez une idée, une solution, ou si vous n'avez rien compris...n'hésitez pas a revenir vers moi.

Je vous remercie

 

[Staple1600]

Re : Macro de publipostage et envoie de mail

Bonjour à tous


Sans voir ton code VBA actuel, on ne peut faire aucun test, non?
Donc joins un fichier exemple.

En attendant ta PJ, tu as été voir du côté de CDO ? (dans ce cas, on se passe d'Outlook donc plus de message d'alerte)

 

[white-angel]

Re : Macro de publipostage et envoie de mail

Bonjour,
Merci de votre réponse.
J'y ai pensé à la PJ, malheureusement le travail est ultra confidentiel.
Je vais essayer de vous faire un petit fichier d'exemple.
J'ai effectivement regarder coté CDO mais je n'arrive pas à l'appliquer.

J'ai un modèle de publipostage Word. Je l'associe à une base de donnée en txt. puis une macro word vient automatiquement changé quelques champs de fusion sur la page, puis selectionner le CONTACT 1 de ma base afin d'envoyer le publipostage. Une fois terminé, la macro passe automatiquement au CONTACT 2. et ce, jusqu'au contact 4.
J'utilise donc un :

with activedocument.MailMerge

.mailaddressfieldname = "CONTACT_1"
.destination = wdSendToMail
.SuppressBlankLines = true
With datasource
.firstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
end with
.Execute Pause:=False
End with

Ceci fonctionne. Il n'y a que le problème du message d'alerte Outlook

Cordialement

 

[Staple1600]

Re : Macro de publipostage et envoie de mail

Re

J'y ai pensé à la PJ, malheureusement le travail est ultra confidentiel.

Rien ne t'empêche de créer un fichier exemple simplifié expurgé de toute donnée confidentielle.
A moins que tu considères que ton code VBA soit confidentiel

Comme dit précédemment, avec CDO pas de message, donc pourquoi persister avec Outlook si le message d'alerte te dérange ?

 

[white-angel]

Re : Macro de publipostage et envoie de mail

Re

Le code macro n'est lui pas confidentiel. Je vous ferai un petit fichier exemple

Auriez vous un exemple de publipostage avec CDO ?
Je tiens à préciser que nous n'avons malheureusement pas les droits sur les postes utilisateurs, nous ne pouvons donc pas installer de nouveau logiciel (style clickyes)

 

[white-angel]

Re : Macro de publipostage et envoie de mail

Si je vous colle mes 2 macro, et que je vous poste une macro de oliv' (le fameux), pourriez vous essayer de l'adapter? Je planche depuis plusieurs semaines, je craque ;'(

 

[Staple1600]

Re : Macro de publipostage et envoie de mail

Bonsoir

Collez
Au moins on aura de la matière à étudier.

 

[white-angel]

Re : Macro de publipostage et envoie de mail

Ok, c'est parti (Je tiens à préciser que ce n'est pas mon métier de base. Je fais ca juste pour que ca fonctionne)

Donc, sur un modèle de lettre publipostage WORD, J'ai cette macro :

Dim x As New EventClassModule
Public mois_fr As String
Public mois_eng As String




Sub publipostage()

If MsgBox("veuillez vous assurer que la macro est présente dans Outlook", vbYesNo + vbExclamation) = vbNo Then Exit Sub


EnableEventHandler

question1:
datenum = InputBox("Quelle est la date au format numérique ?", "date format numérique")
If datenum = "" Then
MsgBox ("Annulation")
Exit Sub
End If

question2:
mois_fr = InputBox("Quel est le mois en Francais suivi de la date numérique ?", "mois Fr")
If mois_fr = "" Then
MsgBox ("annulation, retour à la première question")
GoTo question1
End If

mois_eng = InputBox("Quel est le mois en Anglais suivi de la date numérique ?", "mois En")
If mois_eng = "" Then
MsgBox ("annulation, retour à la première question")
GoTo question2
End If




    Selection.MoveDown Unit:=wdLine, Count:=17
    Selection.MoveRight Unit:=wdCharacter, Count:=3
    Selection.TypeText Text:=datenum
    Selection.MoveDown Unit:=wdLine, Count:=3
    Selection.MoveRight Unit:=wdCharacter, Count:=21
    Selection.TypeText Text:=datenum
    Selection.MoveDown Unit:=wdLine, Count:=3
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:=mois_eng
    Selection.MoveDown Unit:=wdLine, Count:=21
    ActiveDocument.MailMerge.Fields.Add Range:=Selection.Range, Name:= _
        "CONTACT_1"

    With ActiveDocument.MailMerge
    
        .MailAddressFieldName = "CONTACT_1"
        .Destination = wdSendToEmail
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With

    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    ActiveDocument.MailMerge.Fields.Add Range:=Selection.Range, Name:= _
        "CONTACT_2"

    With ActiveDocument.MailMerge
        .MailAddressFieldName = "CONTACT_2"
        .Destination = wdSendToEmail
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With


    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    ActiveDocument.MailMerge.Fields.Add Range:=Selection.Range, Name:= _
        "CONTACT_3"

    With ActiveDocument.MailMerge
        .MailAddressFieldName = "CONTACT_3"
        .Destination = wdSendToEmail
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With


    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    ActiveDocument.MailMerge.Fields.Add Range:=Selection.Range, Name:= _
        "CONTACT_4"

    With ActiveDocument.MailMerge
        .MailAddressFieldName = "CONTACT_4"
        .Destination = wdSendToEmail
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With

DisableEventHandler


End Sub

Sub EnableEventHandler()
Set x.App = Word.Application
End Sub

Sub DisableEventHandler()
Set x.App = Nothing
End Sub

J'ai un EventclassModule qui me change l'objet du mail du publipostage pour qu'il soit personnalisé selon le destinataire :

Public WithEvents App As Word.Application



Sub App_MailMergeBeforeRecordMerge(ByVal Doc As Document, Cancel As Boolean)


' set this to be the exact name (uppercase/lowercase are significant here) of the field you want to use

Const strSubjectFieldName = "PARTENAIRE"
Doc.MailMerge.MailSubject = "sl " & Doc.MailMerge.DataSource.DataFields(strSubjectFieldName).Value & "PUBLIPOSTAGE1 - au " & ThisDocument.mois_fr & " - at " & ThisDocument.mois_eng
End Sub

Une macro dans Outlook qui me permet de rajouter une pièce jointe dans chaque mail en fonction de l'objet :

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As _
Boolean)

repertoire = "C:\Tableaux Excel\PJ\publi1\"
repertoire2 = "C:\Tableaux Excel\PJ\publi2\"


If Item.Class = olMail Then
Dim objCurrentMessage As MailItem
Set objCurrentMessage = Item
If UCase(objCurrentMessage.Subject) Like "*PUBLIPOSTAGE1*" Then
On Error Resume Next

'Pour ajouter un document personnalisé d'après le destinataire du mail
docperso = repertoire & objCurrentMessage.Subject & ".xls"
objCurrentMessage.Attachments.Add Source:=docperso


'On supprime le terme PUBLIPOSTAGE du sujet
objCurrentMessage.Subject = Replace(objCurrentMessage.Subject, _
"PUBLIPOSTAGE1", "")

'On sauvegarde le mail
objCurrentMessage.Save
End If


If UCase(objCurrentMessage.Subject) Like "*PUBLIPOSTAGE2*" Then
On Error Resume Next

'Pour ajouter un document personnalisé d'après le destinataire du mail
docperso = repertoire2 & objCurrentMessage.Subject & ".xls"
objCurrentMessage.Attachments.Add Source:=docperso

'On supprime le terme PUBLIPOSTAGE du sujet
objCurrentMessage.Subject = Replace(objCurrentMessage.Subject, _
"PUBLIPOSTAGE2", "")

'On sauvegarde le mail
objCurrentMessage.Save
End If


Set objCurrentMessage = Nothing
End If

End Sub

Voilà. Je ne pense pas que vous ayez besoin du modèle WORD. Un truc bateau pouvant faire l'affaire.

J'ai trouvé plusieurs solution proposées par Oliv' à cette adresse :
Ce lien n'existe plus

Voilà normalement vous avez tout. Je continue de travailler dessus car je ne vous exploite pas. !!

Merci de votre aide, et de vous intéresser à mon problème.

 

[white-angel]

Re : Macro de publipostage et envoie de mail

Bonjour
J'ai finalement opté pour le déblocage d'un logiciel de mapilab afin d'autoriser l'envoi de mail via word.
Ce ne sera surement pas la solution pour quelqu'un qui cherche un solution via VBA, mais je n'aurais que ca.
Merci de votre aide. Je met en résolu.
A bientot.

JB

 

[mariesmith]

Re : [résolu] Macro de publipostage et envoie de mail

OUI MAIS : Outlook2007 ne me pose aucun problème, mais Outlook 2003 m'affiche le message tant connu : Un programme tente d'envoyer un mail en votre nom.
?????

 

[white-angel]

Re : [résolu] Macro de publipostage et envoie de mail

Bonjour,

Je n'ai pas compris votre message Mariesmith ?