IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Envoi mail via excel [XL-2010]


Sujet :

Macros et VBA Excel

  1. #1
    Membre à l'essai
    Homme Profil pro
    Étudiant
    Inscrit en
    Octobre 2012
    Messages
    30
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Finance

    Informations forums :
    Inscription : Octobre 2012
    Messages : 30
    Points : 22
    Points
    22
    Par défaut Envoi mail via excel
    Bonjour,

    J’ai une macro qui sert à envoyer des mails de manière automatique ligne par ligne.

    Seulement il arrive que j’ai plusieurs lignes avec le même destinataire, mais je dois intégrer un corps de mail bien distinct malgré le fait que ce soit le même destinataire.

    J’aimerais savoir comment je pourrais faire pour que ma macro envoi un seul mail par dentinaire, et que les corps de mail s’intègre les uns après les autres dans mon mail.

    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
    For i = 2 To Sheets("instruction mailing").Range("Q650000").End(xlUp).Row
      Set MonOutlook = CreateObject("Outlook.Application")
      Set monmessage = MonOutlook.CreateItem(0)
      monmessage.SentOnBehalfOfName = expediteur
      monmessage.display
      monmessage.To = Cells(i, 1)
      monmessage.Cc = "xxxx"
      monmessage.Subject = Cells(i, 2)
      corps = Cells(i, 3)
      corps = corps & vbCrLf & vbCrLf
      corps = corps & Cells(i, 4)
      corps = corps & vbCrLf
      corps = corps & Cells(i, 5)
      corps = corps & vbCrLf
      corps = corps & "xxxx"
      corps = corps & vbCrLf & vbCrLf
      corps = corps & Cells(i, 6)
      corps = corps & vbCrLf
      corps = corps & Cells(i, 7)
      monmessage.body = corps & monmessage.body
      monmessage.send
      Next i

  2. #2
    Expert éminent sénior
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 200
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 200
    Points : 14 346
    Points
    14 346
    Par défaut
    Bonjour,

    Est-ce que toutes les cellules se trouvant dans la colonne du destinataire doivent être incluses dans le message ? Sinon, donne un exemple.
    Cordialement.

    Daniel

    La plus perdue de toutes les journées est celle où l'on n'a pas ri. Chamfort

  3. #3
    Membre à l'essai
    Homme Profil pro
    Étudiant
    Inscrit en
    Octobre 2012
    Messages
    30
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Finance

    Informations forums :
    Inscription : Octobre 2012
    Messages : 30
    Points : 22
    Points
    22
    Par défaut
    En a2 par exemple j’ai un destinataire x avec les différentes données du corps de message en b2, c2, d2 etc une fois qu’il arrive au bout de la colonne q2, il envoie le mail. Ensuite ma macro crée un nouveau message ou elle intègre le destinataire en a3 et inclus les différentes données du corps de message en b3, c3, etc jusqu'à la colonne Q3.

    Du coup, j’ai un mail qui part pour chaque ligne.

    Dans mon exemple la cellule a2 et a3 ont la même adresse mail « x ».

    Comment je pourrais faire pour que ma macro envoie seulement un seul mail.

    C'est-à-dire que mon message inclurai le destinaire en a2 ou a3, peu importe puisque c’est le même destinataire mais par contre dans mon corps de message, il y aurai les données b2,c2,d2 etc et également les données b3,c3,d3, etc et pourquoi pas les données b4,c4 etc.. du moment que c’est le même destinataire.

    Puis ma macro passerait à la ligne d’après etc
    Cet exemple peut varier puisque je peux me retrouver avec 10 destinataires similaires par exemple.

    En fait tant qu’il y a un destinataire similaire, elle envoie un seul mail.

    Si tous les destinataires sont différents et que j’ai par exemple 10 lignes, la macro enverrait 10 messages

    Est ce que cela peut t'aider ?

  4. #4
    Expert éminent sénior
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 200
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 200
    Points : 14 346
    Points
    14 346
    Par défaut
    Je ne l'ai pas testé, mais ça devrait le faire :

    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
    Sub test4()
    Dim MonOutlook As Object, Col As Integer, Corps As String
    Set MonOutlook = CreateObject("Outlook.Application")
    With Sheets("instruction mailing")
        For i = 2 To .Range("Q650000").End(xlUp).Row
            Set monmessage = MonOutlook.CreateItem(0)
            monmessage.SentOnBehalfOfName = expediteur
            monmessage.display
            monmessage.To = .Cells(i, 1)
            monmessage.Cc = "xxxx"
            monmessage.Subject = .Cells(i, 2)
            Do
                For Col = 3 To .Cells(i, Columns.Count).End(xlToLeft).Column
                    Corps = Corps & .Cells(i, Col).Value
                    Corps = Corps & vbCrLf
                Next Col
            Loop While .Cells(i, 1) <> .Cells(i - 1, 1)
            monmessage.body = Corps & monmessage.body
            monmessage.send
        Next i
    End With
    End Sub
    Cordialement.

    Daniel

    La plus perdue de toutes les journées est celle où l'on n'a pas ri. Chamfort

  5. #5
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut heu
    bonjour

    la méthode "find et find next" agrémentée d'un offset(x,y) ferait parfaitement l'affaire pour ce genre de travail


    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  6. #6
    Membre à l'essai
    Homme Profil pro
    Étudiant
    Inscrit en
    Octobre 2012
    Messages
    30
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Finance

    Informations forums :
    Inscription : Octobre 2012
    Messages : 30
    Points : 22
    Points
    22
    Par défaut
    Daniel,

    cela semble être ce qu'il me faut mais il y a un problème, quand j'insère ton code et que je lance la macro, cela fait planter mon excel. j'ai l'impression que la boucle do ... loop while ne s'arrete jamais ?

    A patrick :

    Je ne connais pas find et find next. Comment peut-on s'en servir dans ce cas de figure.

    J'apprend tout seul VBA, c'est pas facile. A part les boucles simples et certaines conditions. Ca reste assez difficile et pas donné à tout le monde de savoir faire ça !

    Cordialement.

    julien

  7. #7
    Expert éminent sénior
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 200
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 200
    Points : 14 346
    Points
    14 346
    Par défaut
    Oups, tu as parfaitement raison.
    Cordialement.

    Daniel

    La plus perdue de toutes les journées est celle où l'on n'a pas ri. Chamfort

  8. #8
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut re
    re
    voila un exemple en considérant que les adresses mail sont en colonne (A)
    et les texte associé en colonne (B)et le tout dans le sheets(1)

    colle ca dans un module standard

    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
    37
    38
    39
    40
    41
     
    Option Explicit
    Type donnee
        adressmail As String
        texte As String
    End Type
     
    Sub mailing()
        Dim destinataire(500) As donnee, i As Long, e As Long, d As Variant, cel As Range, elem As Variant, c As Range
        Dim firstAddress As String
        'on va lister la plage de nom en colonne A dans un dictionnaire pour en suprimer les doublons
        Set d = CreateObject("Scripting.Dictionary")
        For Each cel In Sheets(1).Range("a1:a10") 'dans la plage a1 a10 a toi d'adapter la tienne
            d.Item(cel.Value) = ""
        Next cel
        'on boucle sur tout les elements du dictionnaire
        For Each elem In d
            'dans la plage a1 a10 a toi d'adapter la tienne
            With Worksheets(1).Range("a1:a10")
                Set c = .Find(elem, LookIn:=xlValues)    'on cherche la valeur de elem
                If Not c Is Nothing Then    'si il existe
                    firstAddress = c.Address
                    i = i + 1
                    destinataire(i).adressmail = elem
                    Do
                        'on boucle sur toute les cellule pour voir si on ne trouve pas un nom identiquejusque qu'a qu'on soit arriver a la premiere
                        destinataire(i).texte = destinataire(i).texte & vbCrLf & c.Offset(0, 1)  ' et on inscrit dans le destinataire .texte la valeur de la cellule a droite des noms
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> firstAddress
                End If
            End With
        Next
        'un essaie dans un message box dans une boucle
        For e = 1 To i
       ' a la place du msgbox envoie le mail avec destinataire (e) .adressmail pour le destinataire 
    'et destinataire(e).texte pour le contenu du message 
     
      MsgBox "il y a  " & i & "destinataires" & vbCrLf & vbCrLf & "Destinataire  " & e & "  " & destinataire(e).adressmail & vbCrLf & vbCrLf & "voici le texte qui y est associé " & vbCrLf & destinataire(e).texte
        Next
     
    End Sub
    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  9. #9
    Expert éminent sénior
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 200
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 200
    Points : 14 346
    Points
    14 346
    Par défaut
    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
    Sub test4()
    Dim MonOutlook As Object, Col As Integer, Corps As String
    Set MonOutlook = CreateObject("Outlook.Application")
    With Sheets("instruction mailing")
        For i = 2 To .Range("Q650000").End(xlUp).Row
            Set monmessage = MonOutlook.CreateItem(0)
            monmessage.SentOnBehalfOfName = expediteur
            monmessage.display
            monmessage.To = .Cells(i, 1)
            monmessage.Cc = "xxxx"
            monmessage.Subject = .Cells(i, 2)
            Do
                For Col = 3 To .Cells(i, Columns.Count).End(xlToLeft).Column
                    Corps = Corps & .Cells(i, Col).Value
                    Corps = Corps & vbCrLf
                    i = i + 1
                Next Col
            Loop While .Cells(i, 1) <> .Cells(i - 1, 1)
            monmessage.body = Corps & monmessage.body
            monmessage.send
        Next i
    End With
    End Sub
    Cordialement.

    Daniel

    La plus perdue de toutes les journées est celle où l'on n'a pas ri. Chamfort

  10. #10
    Membre à l'essai
    Homme Profil pro
    Étudiant
    Inscrit en
    Octobre 2012
    Messages
    30
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Finance

    Informations forums :
    Inscription : Octobre 2012
    Messages : 30
    Points : 22
    Points
    22
    Par défaut
    Daniel,

    Le code ne fonctionne pas. dorénavant la boucle fonctionne mais quand on arrive au next i. ça ne remonte pas à for. du coup il envoi qu'un seul mail.

    Patrick,

    j'ai compris le principe de ta macro et je fais des modifications vers la fin, mais je ne sais pas si cela va fonctionner.

    Je vous joins un fichier excel avec les Screenshots de ce qui devrait être envoyé.

    Cordialement.

    Julien
    Images attachées Images attachées   
    Fichiers attachés Fichiers attachés

  11. #11
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut
    re
    voila un exemple un peu plus precis
    il prend en compte maintenant toute les colonnes de b a q de chaque destinataires sans les doublons bien entendu

    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
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
     
    Option Explicit
    Type donnee
        adressmail As String
        texte As String
    End Type
     
    Sub mailing()
        Dim destinataire(500) As donnee, i As Long, e As Long, d As Variant, cel As Range, elem As Variant, c As Range, Col As Long
        Dim firstAddress As String, a As Long
        'on va lister la plage de nom en colonne A dans un dictionnaire pour en suprimer les doublons
        Set d = CreateObject("Scripting.Dictionary")
        For Each cel In Sheets("instruction mailing").Range("a1:a" & Range("a" & Rows.Count).End(xlUp).Row) 'dans la plage a1 a10 a toi d'adapter la tienne
            d.Item(cel.Value) = ""
        Next cel
        'on boucle sur tout les elements du dictionnaire
        For Each elem In d
            'dans la plage a1 a10 a toi d'adapter la tienne
            With Sheets("instruction mailing").Range("a1:a" & Range("a" & Rows.Count).End(xlUp).Row)
                Set c = .Find(elem, LookIn:=xlValues)    'on cherche la valeur de elem
                If Not c Is Nothing Then    'si il existe
                    firstAddress = c.Address
                    i = i + 1
                    destinataire(i).adressmail = elem
                    Do
                        For Col = 2 To 16    ' de la colonne "b" a "q" pour récupérer le texte
                            If Cells(c.Row, Col) <> "" Then
                                'on boucle sur toute les cellule pour voir si on ne trouve pas un nom identiquejusque qu'a qu'on soit arriver a la premiere
                                destinataire(i).texte = destinataire(i).texte & vbCrLf & Cells(c.Row, Col)    ' et on inscrit dans le destinataire .texte la valeur de la cellule a droite des noms
                            End If
                        Next
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> firstAddress
                End If
            End With
        Next
        'un essaie dans un message box dans une boucle
        For e = 1 To i
           ' MsgBox "il y a  " & i & "destinataires" & vbCrLf & vbCrLf & "Destinataire  " & e & "  " & destinataire(e).adressmail & vbCrLf & vbCrLf & "voici le texte qui y est associé " & vbCrLf & destinataire(e).texte
            'on appelle la fonction envoie_message avec les deux arguments destnataires et le corps du message
            envoie_message destnataire(e).adressmail, destinataire(e).texte
        Next
        'je n'ai pas tester la fonction envoie_message  car je ne me sert pas d'outlook je te laisse le soin de la rectifier si besoin est
    End Sub
    Function envoie_message(dest As String, texto As String)
        Dim MonOutlook As Object, Col As Integer, Corps As String
        Set MonOutlook = CreateObject("Outlook.Application")
        Set monmessage = MonOutlook.CreateItem(0)
        monmessage.SentOnBehalfOfName = expediteur
        monmessage.display
        monmessage.To = dest
        monmessage.Cc = "xxxx"
        ' monmessage.Subject = .Cells(i, 2)ici daniel t'a mis la colonne b comme titre de sujet alors que tu a dis que le corps du message se trouve de la colonne b a q  donc a toi d'adapter
        monmessage.body = texto
        monmessage.send
    End Function
    au plaisir

    je viens de voir tes clichés et ton fichier en exemple
    je t'en refais un au propre
    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  12. #12
    Membre à l'essai
    Homme Profil pro
    Étudiant
    Inscrit en
    Octobre 2012
    Messages
    30
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Finance

    Informations forums :
    Inscription : Octobre 2012
    Messages : 30
    Points : 22
    Points
    22
    Par défaut
    c'est nickel, ça fonctionne parfaitement même si je suis impressionné par le code. Je vais galérer un peu pour essayer de tout comprendre.

    Juste une dernière chose. je me suis trompé, le corps du mail commence à partir de la colonne C, et l'objet du mail se trouve dans la colonne B

    est ce que vous pourriez modifié le code pour que l'objet du mail s’insère comme il faut ?

    Merci beaucoup pour votre aide.

    Julien.

  13. #13
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut re
    voila
    encore une fois regarde la fonction envoie_message car moi je n'utilise pas outlook

    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
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
     
    Option Explicit
    Type donnee
        adressmail As String
        texte As String
        sujetmessage As String
     
    End Type
    Dim destinataire(500) As donnee    ' j'ai mis 500 au cas ou tu aurais 500 mail a envoyer tu peut augmenter a ton cas
    Sub mailing()
       dim  i As Long, e As Long, d As Variant, cel As Range, elem As Variant, c As Range, Col As Long
        Dim firstAddress As String, a As Long
        'on va lister la plage de nom en colonne A dans un dictionnaire pour en suprimer les doublons
        Set d = CreateObject("Scripting.Dictionary")
        For Each cel In Sheets("instruction mailing").Range("a1:a" & Range("a" & Rows.Count).End(xlUp).Row)    'dans la plage a1 a10 a toi d'adapter la tienne
            d.Item(cel.Value) = ""
        Next cel
        'maintenant que l'on a plus de doublons
        'on boucle sur tout les elements du dictionnaire
        For Each elem In d
            'dans la colonne a on va chercher tout les ocurence de chaque elements du dictionnaire
            With Sheets("instruction mailing").Range("a1:a" & Range("a" & Rows.Count).End(xlUp).Row)
                Set c = .Find(elem, LookIn:=xlValues)    'on cherche la valeur de elem
                If Not c Is Nothing Then    'si il existe
                    firstAddress = c.Address
                    i = i + 1
                    destinataire(i).adressmail = elem    'on prend l'element du dictionnaire pour le destinataire
                    destinataire(i).sujetmessage = c.Offset(0, 1)    ' la cellule a droite de la cellule trouvée donc (colonne B) te donne le sujet
                    Do
                        'on boucle sur toute les cellule pour voir si on ne trouve pas un nom identique jusque qu'a qu'on soit arriver a la premiere adresse trouvée
     
                        For Col = 3 To 16    ' boucle sur les colonnes "C" a "Q" pour récupérer le texte
                            If Cells(c.Row, Col) <> "" Then    'on la prend si elle n'est pas vide ca evite des sauts de lignes pour rien
                                destinataire(i).texte = destinataire(i).texte & vbCrLf & Cells(c.Row, Col)    ' et on inscrit dans le destinataire .texte la valeur de la cellule a droite des noms
                            End If
                        Next
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> firstAddress
                End If
            End With
        Next
        'un essaie dans un message box dans une boucle
        For e = 1 To i
            ' MsgBox "il y a  " & i & "destinataires" & vbCrLf & vbCrLf & "Destinataire  " & e & "  " & destinataire(e).adressmail & vbCrLf & vbCrLf & "voici le texte qui y est associé " & vbCrLf & destinataire(e).texte
            'on appelle la fonction envoie_message avec les deux arguments destnataires et le corps du message
     
            envoie_message destnataire(e).adressmail, destinataire(e).sujetmessage, destinataire(e).texte
            'TRADUCTION  envoie_message destinataire             ,         sujet               ,corps du message
     
        Next
        'je n'ai pas tester la fonction envoie_message  car je ne me sert pas d'outlook je te laisse le soin de la rectifier si besoin est
    End Sub
    Function envoie_message(dest As String, sujet, texto As String)
        Dim MonOutlook As Object
        Set MonOutlook = CreateObject("Outlook.Application")
        Set monmessage = MonOutlook.CreateItem(0)
        monmessage.SentOnBehalfOfName = expediteur
        monmessage.display
        monmessage.To = dest
        monmessage.Cc = "xxxx"
        monmessage.Subject = sujet
        monmessage.body = texto
        monmessage.send
    End Function
    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  14. #14
    Membre à l'essai
    Homme Profil pro
    Étudiant
    Inscrit en
    Octobre 2012
    Messages
    30
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Finance

    Informations forums :
    Inscription : Octobre 2012
    Messages : 30
    Points : 22
    Points
    22
    Par défaut
    il me met ce message.

    type d'argument Byref incompatible en surlignant ".texte" ?

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    envoie_message destinataire(e).adressmail, destinataire(e).sujetmessage, destinataire(e).texte

  15. #15
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut
    re
    met un apostrophe devant l'appel a la fonction et remet le msgbox en route et dis moi ce que le msgbox te dit

    au plaisir

    javais oublié que toi ta liste commencait en a2 et non pas en a1
    change ca dans la plage

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Sheets("instruction mailing").Range("a2:a" & Range("a" & Rows.Count).End(xlUp).Row)
    a la place de
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Sheets("instruction mailing").Range("a1:a" & Range("a" & Rows.Count).End(xlUp).Row)
    oupppss....

    au plaisir

    j'ai apporté quelques ameliorations
    en effet il y avait quand meme la repitition de
    "dear all"
    "can you send......."
    et thanks regard"
    il ne sont plus en double maintenant
    voila le code

    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
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
     
    Option Explicit
    Type donnee
        adressmail As String
        texte As String
        sujetmessage As String
     
    End Type
        ' j'ai mis 500 au cas ou tu aurais 500 mail a envoyer tu peut augmenter a ton cas
    Sub mailing()
        Dim destinataire(500) As donnee
        Dim i As Long, e As Long, d As Variant, cel As Range, elem As Variant, c As Range, Col As Long
        Dim firstAddress As String, a As Long
        'on va lister la plage de nom en colonne A dans un dictionnaire pour en suprimer les doublons
        Set d = CreateObject("Scripting.Dictionary")
        For Each cel In Sheets("instruction mailing").Range("a2:a" & Range("a" & Rows.Count).End(xlUp).Row)    'dans la plage a1 a10 a toi d'adapter la tienne
            d.Item(cel.Value) = ""
        Next cel
        'maintenant que l'on a plus de doublons
        'on boucle sur tout les elements du dictionnaire
        For Each elem In d
            'dans la colonne a on va chercher tout les ocurence de chaque elements du dictionnaire
            With Sheets("instruction mailing").Range("a2:a" & Range("a" & Rows.Count).End(xlUp).Row)
                Set c = .Find(elem, LookIn:=xlValues)    'on cherche la valeur de elem
                If Not c Is Nothing Then    'si il existe
                    firstAddress = c.Address
                    i = i + 1
                    destinataire(i).adressmail = elem    'on prend l'element du dictionnaire pour le destinataire
                    destinataire(i).texte = .Cells(c.Row, 3) & vbCrLf & .Cells(c.Row, 4)
                    Do
                        'on boucle sur toute les cellule pour voir si on ne trouve pas un nom identique jusque qu'a qu'on soit arriver a la premiere adresse trouvée
    destinataire(i).sujetmessage = c.Offset(0, 1)
                        For Col = 5 To 15   ' boucle sur les colonnes "C" a "Q" pour récupérer le texte
                            If Cells(c.Row, Col) <> "" Then    'on la prend si elle n'est pas vide ca evite des sauts de lignes pour rien
                                destinataire(i).texte = destinataire(i).texte & vbCrLf & Cells(c.Row, Col)    ' et on inscrit dans le destinataire .texte la valeur de la cellule a droite des noms
                            End If
                        Next
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> firstAddress
                destinataire(i).texte = destinataire(i).texte & vbCrLf & .Cells(c.Row, 16) & vbCrLf & .Cells(c.Row, 17)
                End If
     
            End With
        Next
        'un essaie dans un message box dans une boucle
        For e = 1 To i
           ' MsgBox destinataire(e).adressmail & vbCrLf & vbCrLf & destinataire(e).texte
            'on appelle la fonction envoie_message avec les deux arguments destnataires et le corps du message
     
            envoie_message destinataire(e).adressmail, destinataire(e).sujetmessage, destinataire(e).texte
            'TRADUCTION  envoie_message destinataire             ,         sujet               ,corps du message
     
        Next
        'je n'ai pas tester la fonction envoie_message  car je ne me sert pas d'outlook je te laisse le soin de la rectifier si besoin est
    End Sub
    Function envoie_message(dest As String, sujet, texto As String)
         Dim MonOutlook As Object
        Set MonOutlook = CreateObject("Outlook.Application")
        Set monmessage = MonOutlook.CreateItem(0)
        monmessage.SentOnBehalfOfName = expediteur
        monmessage.display
        monmessage.To = dest
        monmessage.Cc = "xxxx"
        monmessage.Subject = sujet
        monmessage.body = texto
        monmessage.send
    End Function
    j'oubliais :
    tout a l'heure tu avais une erreur parce que j'ai oublié "i" a "destinataire" je
    tape trop vite
    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  16. #16
    Membre à l'essai
    Homme Profil pro
    Étudiant
    Inscrit en
    Octobre 2012
    Messages
    30
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Finance

    Informations forums :
    Inscription : Octobre 2012
    Messages : 30
    Points : 22
    Points
    22
    Par défaut
    Il y a un message d'erreur a ce niveau :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    envoie_message destinataire(e).adressmail, destinataire(e).texte
    message : "erreur de compilation argument non facultatif en surlignant envoie_message"

    la macro ne se lance pas du coup.

    Comment cela se fait-il ?

    julien.

  17. #17
    Membre à l'essai
    Homme Profil pro
    Étudiant
    Inscrit en
    Octobre 2012
    Messages
    30
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant
    Secteur : Finance

    Informations forums :
    Inscription : Octobre 2012
    Messages : 30
    Points : 22
    Points
    22
    Par défaut
    Finalement ça fonctionne, il afllait juste rajouter ça au niveau de function envoie_message:

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    dim monmessage As Object
    Merci beaucoup !!

    Julien

  18. #18
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut re
    bonjour

    dans ton dernier message tu disais avoir une erreur

    tu avais que 2 arguments dans l'appel hors dans mon dernier model il y en a 3

    l'addresse le sujet le corps du mess
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  19. #19
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut re
    re
    c'est bizzare que ca fonctionne tel que tu me le dis puisque dans le dernier model que je t'ai fait il y a 3 arguments et non plus 2

    a tu bien pris le dernier?

    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Envoi Mail via Excel
    Par isa0144 dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 05/07/2014, 00h37
  2. [XL-2003] Envoi mail via excel: texte ne s'affiche pas
    Par chrisssou dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 11/09/2012, 16h50
  3. [XL-2010] Envoi mail via Outlook depuis excel en VBA
    Par PATDRO dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 07/08/2012, 09h40
  4. Envoi d'un mail via excel
    Par tidams dans le forum Macros et VBA Excel
    Réponses: 9
    Dernier message: 18/01/2009, 01h05
  5. [VBA-Excel]Probleme Mailing via Excel
    Par Mugette dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 09/10/2006, 14h08

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo