XL 2013 envois d'une pièce jointe personnalisé pour chaque ligne vba (gmail)

[LeanePrsl]

Bonjour,

Je suis entrain de créer une macro qui me permettrai de relancer les factures impayées depuis un tableau excel et une macro.

La macro fonctionne très bien cependant le 1er destinataire reçois sa pièces jointes, mais à partir du second il y a un problème.

Le 2eme destinataire reçoit sa PJ + celle du destinataire du dessus, et par exemple le 25eme destinataire reçoit sa PJ + les 24 précédente....

je vous donne la macro ci-dessous, merci de votre aide.

 

[juvaxe]

Bonjour

Normal ...

Tu fais une seule fois "Dim cdo_msg as New CDO.message"

Cet objet va te servir tout le temps de ta boucle d'envoi. Il faut savoir que les AddAttacchment se cumulent pour permettre d'envoyer plusieurs pièces jointes (comme tu le fais d'ailleurs). La pile de pièces jointes ne fait qu'augmenter à chaque destinataire : elle n'est jamais réinitialisée.

Je ne connais pas le contraire, pour autant qu'il existe, de AddAttachement pour permettre de repartir sur une pile vierge à chaque boucle d'envoi.

Par contre je connais la solution qui est de mettre :

Dim cdo_msg as Object en début de module,

et de commencer la boucle d'envoi des messages par :

Set cdo_msg = CreateObject("CDO.Message")

et ensuite de tout remettre en place, à chaque fois [ce que tu voulais éviter], dans le message à savoir les paramètres généraux de configuration et les paramètres particuliers qui concernent le destinataire qui fait l'objet de la ligne en cours du tableau de remplissage.

Bonne réception

Cdt

 

[juvaxe]

Bonjour

Je reviens sur mon message précédent :

Avant de reprendre ta procédure, je te propose d'essayer de réinitialiser la liste des pièces jointes à chaque itération en ajoutant "cdo.msg.Attachment = Nothing" avant de faire les attachements des deux pièces jointes de chacun des destinataires.

Cdt.

 

[juvaxe]

Bonjour ...

Désolé, mon message précédent n'est pas bon.

C'est "cdo_msg.Attachments.DeleteAll" qu'il convient de mettre (Attachments comporte un "s" dans cette commande). Je viens de tester.

Cdt

 

[patricktoulon]

Bonjour
perso je séparerais la boucle du moulin CDO
le moulin cdo dans une fonction la boucle dans une sub
l'object serait créé a chaque fois au propre
et vu le nombre de ligne
je ferais le moulin CDO dans un vbs dynamique histoire de ne pas saturer excel par ce que là ca fait beaucoup quand même
surtout que tant que CDO renvoie pas un statut il ne passe pas a la suivante
vérifier aussi si le nombre de mail en un laps de temps n'est pas trop grand
Google a durci e ses règles à ce niveau surtout quand c'est effectué avec une tiers application (en l’occurrence excel VBA)

 

[Hasco]

Bonjour,

Voici une structure que j'emploie en général avec createobject mais devrait fonctionner ici aussi.
L'idée, créer une seule configuration de cdo pour tous les messages.


Dans sub Relance()

Avant de lancer la boucle, on vérifie que la configuration est prête.
A chaque itération un nouveau message est créé et envoyé avec la même configuration
Destruction de la configuration en fin de boucle.
N.B. ne pas oublier de finir la macro (construction du message)

Option Explicit

Private CdoConfig As CDO.Configuratione
Private CdoConfigErrorMessage As String

Function GetCdoConfig() As Boolean
    CdoConfigErrorMessage = ""
    On Error GoTo FIN
    '
    ' Si la configuration n'est pas déjà prête
    ' La créer et la préparer
    If CdoConfig Is Nothing Then
        Set CdoConfig = New CDO.Configuration
        With CdoConfig
            .Fields(cdoSMTPServer) = "smtp.gmail.com"
            .Fields(cdoSMTPConnectionTimeout) = 60
            .Fields(cdoSendUsingMethod) = cdoSendUsingPort
            .Fields(cdoSMTPServerPort) = 465
            .Fields(cdoSMTPAuthenticate) = cdoBasic
            .Fields(cdoSMTPUseSSL) = True
            .Fields(cdoSendUserName) = "trucmachin@gmail.com"    ' à adapter
            .Fields(cdoSendPassword) = "motdepasse ' à adapter"
            .Fields.Update
        End With
    End If
FIN:
    If Err.Number <> 0 Then CdoConfigErrorMessage = Err.Description
    GetCdoConfig = Not CdoConfig Is Nothing
    On Error GoTo 0
End Function

Sub Relance()
    Dim cdo_msg As CDO.Message
    Dim Cellule As Range
    Dim Ligne As Long

    '
    ' L'appel à la fonction GetCdoConfig
    ' Vérifiera si la configuration existe déjà
    '
    If GetCdoConfig() Then
        '
        'Commencer la boucle de création et d'envoi de message individuel
        For Each Cellule In Range("i1:i100000")
            Ligne = Ligne + 1
            If Cells(Ligne, 9).Value = "non" And Cells(Ligne, 11) <= Date Then
                '
                ' Création du nouveau message
                Set cdo_msg = New CDO.Message
                Set cdo_msg.Configuration = CdoConfig
                '
                ' Mettre ici les autres lignes de constitution du message et d'envoi
                '
            End If
            '
            ' Nettoyage de la variable cdo_msg
            Set cdo_msg = Nothing
        Next
        '
        ' Destruction de l'objet configuration qui n'a plus lieu d'être
        Set CdoConfig = Nothing
    Else
        '
        ' Eventuellement afficher le message
        ' d'erreur de configuration
        MsgBox "Relance interrompue en raison de l'erreur suivante : " & vbCrLf & vbCrLf & _
               CdoConfigErrorMessage, vbExclamation, "Relance personnalisée"
    End If

End Sub

[Edit 14:41] il y a sans doute moyen d'optimiser la boucle pour qu'elle n'ait pas à lire 100000 lignes à chaque fois. A moins qu'il y ait effectivement 100000 messages à envoyer à chaque fois.[/Edit]

Cordialement

 

[patricktoulon]

re
@Roblocon belle idée

 

[Hasco]

Bonjour,

J'ai quand même oublié de préciser qu'il ne fallait pas oublier d'attribuer la configuration à chaque message créé (corrigé dans mon précédent post) :

Set cdo_msg.Configuration = CdoConfig

Cela n'aurait peut-être pas été évident pour le demandeur.

Cordialement

 

[LeanePrsl]

Bonjour,

Merci à tous pour vos réponses je vais essayer ce que vous m'avez dis,
Merci infiniment.

Bonne journée.
Léane