XL 2019 Envoyer mails, n’envoie pas toutes les lignes

[Sellig]

Bonjour,

Est-ce que quelqu’un pourrait m’aider à résoudre mon problème sur le tableau joint ?

Lorsque je clique sur ‘’envoyer’’ uniquement les 3 premières lignes sont envoyées, alors que j’ai 5 adresses mails. Et pourtant la ligne « To last_row » est bien présente.

Évidement, j’ai besoin des 2 lignes vides au dessus, Lignes 1 et 2.

Merci par avance pour votre aide.

Cordialement

 

[TooFatBoy]

D'où l'intérêt de d'abord tester avec le Display...

 

[Phil69970]

Re

@Sellig

Le message est assez parlant il me semble !!
Remets display et regardes si tu as une adresse mail valide dans le champ "Destinataire"

 

[Sellig]

Re

@Sellig

Le message est assez parlant il me semble !!
Remets display et regardes si tu as une adresse mail valide dans le champ "Destinataire"

Oui absolument

 

[Phil69970]

Et tu l'as fait ?

Quel résultat ?

Montre les copies d'écran de ce que tu as fait avec le résultat !

 

[Sellig]

Et tu l'as fait ?

Quel résultat ?

Montre les copies d'écran de ce que tu as fait avec le résultat !

Le résultat est qu’il envoie bien la ou les lignes prévue (Fig1) mais également toutes les autres sans adresses mail (Fig2)

Le mieux serait que vous testiez mon fichier joint.

 

[TooFatBoy]

Le résultat est qu’il envoie bien la ou les lignes prévue (Fig1) mais également toutes les autres sans adresses mail (Fig2)

Évidemment, tu as écrit "Fin" en colonne A !!!
C'est d'ailleurs pour éviter ce genre de problème que dans ce cas je préfère chercher la dernière ligne en partant du haut du tableau.

As-tu essayé avec un Tableau Structuré ?

 

[Phil69970]

@Sellig

Je te propose ceci :

Option Explicit

Sub Envoi_mails()
Dim Ws As Worksheet, OutApp As Object, OutMail As Object, DerLig&, i&

Set Ws = Worksheets("Envoi mails")
DerLig = Ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 4 To DerLig
    If Ws.Range("H" & i).Value <> "NON" Then
        On Error Resume Next
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = Ws.Range("A" & i).Value
            .CC = Ws.Range("B" & i).Value
            .BCC = Ws.Range("C" & i).Value
            .Subject = Ws.Range("D" & i).Value
            .Body = Ws.Range("E" & i).Value
            
            If Ws.Range("F" & i).Value <> "" Then
                .Attachments.Add Ws.Range("F" & i).Value
            End If
            If Ws.Range("G" & i).Value <> "" Then
                .Attachments.Add Ws.Range("G" & i).Value
            End If
            
            .Send
        End With
    End If
Next i

MsgBox "Messages Envoyés"
Set OutMail = Nothing: Set OutApp = Nothing
End Sub

Merci de ton retour