problème envoi de pièce jointe dans mail

[pierro77]

Bonjour à tous,

Je vous contacte car j'ai mis en place une macro me permettant d'envoyer des mails automatiquement à une liste de personnes avec une pièce jointe. L'envoi de mail se fait en bouclant dans la colonne E où se trouve les adresse mail des personnes sélectionnées. Cependant, j'ai un problème avec la pièce jointe. Lorsque j'envoie un mail à 5 personnes par exemple, le premier reçoit 1 pièce jointe (OK) ... mais le cinquième reçoit 5 pièces jointes ce qui assez embêtant (si j'en ai 50 à envoyer je ne veux pas que le 50eme recoive 50 pièces jointes mais une seule).
Je vous joins avec ce mail le code de ma macro :

'macro permettant la demande de test et l'envoi automatique de mail aux testeurs sélectionnés
Sub demandetest()
    
    'définition de toutes les variables
    
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody, lig0, lig1, lig2, lig3, lig4, lig5, Adresse, lienphoto, myshoes As String
    Dim Flds As Variant
    Dim i, j As Integer
    Dim lien As String
    Dim photo As Worksheet
    
    'NE PAS MODIFIER CE QUI SUIT : procédure d'envoi des mails
    
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    
    iConf.Load -1    ' CDO Source Defaults
    Set Flds = iConf.Fields
    With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "172.16.4.25" 'serveur SMTP : si problème d'envoi, contacter l'info (5005)
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 'port SMTP
    .Update
    End With
    
    Worksheets("BDD 2012").Activate 'Activation de la feuille "BDD 2012"
    For i = 3 To Range("AD65536").End(xlUp).Row 'parcours l'ensemble des cellules de BDD 2012 jusqu'à la dernière
    If Cells(i, 30) = "sélectionné" Then 'si la cellule ligne i, colonne AD est égale à sélectionné alors instruction envoi de mail
    
    'texte du mail à envoyer
    
    myshoes = Application.InputBox("Entrer le modèle de la chaussure") 'boite de dialogue pour entrer le nom de la chaussure à mettre en test.
    lienphoto = Application.InputBox("Entrer le lien de la photo") 'boite de dialogue pour entrer le lien de la photo de la chaussure préalablement entré dans le "Follow-up"
    
    'Texte du mail (A MODIFIER si besoin)
    
    lig0 = "Bonjour,"
    lig1 = "Dans le cadre de la validation d'usage de nos produits, nous vous proposons de tester les chaussures " & myshoes & " pointure " & Cells(i, 24) & "."
    lig2 = "L'objectif est d'évaluer le vieillissement des produits sur le terrain. Les produits devront être portés au minimum 1 mois."
    lig3 = "Si vous souhaitez tester ce produit, merci de nous envoyer une réponse par mail ou par téléphone (coordonnées ci-dessous). "
    lig4 = "Après avoir reçu une réponse de notre part, vous pourrez venir retirer les chaussures en magasin (demandez le bureau Test Shoes à l'accueil) et nous vous donnerons les instructions pour le test. "
    lig5 = "Nous vous remercions de votre participation et vous souhaitons une bonne journée."
    Adresse = "Tests shoes Quechua" & Chr(13) & "2323, route du Fayet" & Chr(13) & "74700 DOMANCY" & Chr(13) & "Tél : 04 50 47 67 01"

    strbody = lig0 & Chr(13) & Chr(13) & lig1 & Chr(13) & lig2 & Chr(13) & lig3 & Chr(13) & lig4 & Chr(13) & Chr(13) & lig5 & Chr(13) & Chr(13) & Adresse
    'Chr(13) = code pour saut de ligne
    
    'For j = 2 To photo.Range("B65356").End(xlUp).Row
    
            'If Sheets("photo chaussure").Cells(j, 2) = "sélectionné" Then
    ' mettre le lien manuellement : il faudrait que cela soit automatique (si selectionné alors choisi le lien de la photo.
    
    'lien = "C:\WINNT\Profiles\pchaza18\Desktop\Photos chaussure\SA50 profil.jpg" 'lien de la photo de la chaussure
    
    With iMsg
        Set .Configuration = iConf
        .To = Cells(i, 5) 'adresse mail dans la colonne E de la feuille "BDD 2012"
        .CC = ""
        .BCC = ""
        .From = """Tests Shoes Quechua"" <tests.shoes@quechua.com>" 'Expéditeur : Tests.Shoes
        .Subject = "demande de test Quechua" 'Sujet du message
        .TextBody = strbody 'Corps du message
        .Addattachment (lienphoto) 'pièce jointe : ici photo de la chaussure
        .Send 'Envoyé
    End With
        'End If
        'Next j
    Cells(i, 30) = "envoyé le " & Now

    End If
    Next i
    
End Sub

Merci à vous pour votre éclairage!

 

[Yaloo]

Re : problème envoi de pièce jointe dans mail

Bonjour Pierrot, le forum,

Si on réponds juste on gagne une paire de chaussure

Essaie de mettre :

Set iMsg = Nothing
Set iConf = Nothing

Juste avec :

Next i

Cela va "vider" ton message, et donc ta pièce jointe. Faire des essais car je n'ai pas pu tester.

A te relire

Martial

 

[pierro77]

Re : problème envoi de pièce jointe dans mail

Hello Martial,

Merci pour ta réponse. J'ai essayé cette instruction en fin de macro mais ça ne fonctionne pas. En revanche, j'ai changé l'instruction de pièce jointe dans la macro. Je l'ai retiré de la boucle et ça fonctionne beaucoup mieux.

Merci beaucoup à toi en tout cas

 

[Yaloo]

Re : problème envoi de pièce jointe dans mail

Bonjour Pierrot,

Peux tu remettre ta macro, pour voir la modification que tu as apporté, cela permettra peut être à d'autre de résoudre leur problème.

A+