Envoi de mail lotus notes ien boucle via condition sous excel

LGGUESS Messages postés 8 Statut Membre -  
f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

sur la base d'une liste excel , code , libellé code , adresse email, condition(colonne Q = " à revoir"
je souhaite adresser des mails via la macro jointe, en regroupant les codes et libellés d'une même adresse email sur le même envoi
le 1er mail fonctionne mais ma boucle ne marche pas
merci por votre aide



Liste
CODES VALEURS CATEGORIE Adresses Contacts à revoir
QS0003417027" GENEHABITAT 3 Loic.guessant@bnpparibas.com à revoir
FR0011043314 PACHA A1 FCPR bpanhard@galiena.fr à revoir
FR0011043322 PACHA A2 FCPR bpanhard@galiena.fr à revoir
FR0010086595 SIMIANE "D" Loic.guessant@bnpparibas.com à revoir
FR0010709493 ELITE LAS FCP basevaleur@rothschild.com à revoir

Macro

Sub Bouton416_Cliquer()
Dim Session As Object
Dim Dir As Object
Dim Doc As Object
Dim Workspace As Object
Dim EditDoc As Object
Dim LeTexte1 As String
Dim LeTexte2 As String
Dim LeTexteRelance As String
Dim resp As String
Dim nblignes As Integer

Sheets("INVENTAIRE").Select
Range("Q2").Select
Selection.End(xlDown).Select
nblignes = Selection.Rows
'ensuite il suffit de faire une boucle pour traiter les lignes
i = 2

For i = 2 To nblignes
'test de la colonne D
'Do While I <= nblignes

If Cells(i, 17).Value = "à revoir" Then
'Rows(i & ":" & i).Select
Cells(i, 1).Value
Cells.Select
Cells(i, 2).Value
Cells.Select

'Range(i, 3).Value
End If
Next i

LeTexte1 = "Bonjour," & vbCrLf & vbCrLf & "Nous vous remercions de bien vouloir nous communiquer les valorisations à fin de mois des valeurs jointes." _
& vbCrLf & vbCrLf & "L'information est à nous restituer à l'adresse DINAN GS REFERENTIEL VALEURS@bnpparibas.com:" _
& vbCrLf & vbCrLf & "Nous restons à votre disposition." & vbCrLf

LeTexte2 = Cells(i, 1).Value & Space(15) & Cells(i, 2).Value




Set Workspace = CreateObject("Notes.NotesUIWorkspace")
Set Session = CreateObject("notes.NOTESSESSION")
Set Dir = Session.GETDATABASE("", "")
Call Dir.OPENMAIL
Set Doc = Dir.CREATEDOCUMENT





Doc.form = "Memo"
Doc.Subject = "Demande"
Doc.SendTo = Cells(i, 5).Value
Doc.CopyTo = "Loic.guessant@bnpparibas.com"

Doc.Body = LeTexte1 & vbCrLf & LeTexte2 & vbCrLf & vbCrLf & vbCrLf & "Cordialement."




Doc.SaveMessageOnSend = True
Call Doc.Send(False)
Set Session = Nothing
MsgBox "Email sent.", vbOKOnly + vbInformation



Set Db = Nothing
Set Doc = Nothing
Set Workspace = Nothing
Set EditDoc = Nothing

End Sub
A voir également:

3 réponses

Réponse 1 / 3
f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention   1 715
 
Bonjour,

a tester en adaptant les colonnes 

Sub Bouton416_Cliquer()
    Dim Session As Object
    Dim Dir As Object
    Dim Doc As Object
    Dim Workspace As Object
    Dim EditDoc As Object
    Dim LeTexte1 As String
    Dim LeTexte2 As String
    Dim LeTexteRelance As String
    Dim resp As String
    Dim nblignes As Integer

    nblignes = Sheets("INVENTAIRE").Range("D2").End(xlDown).Row
    'ensuite il suffit de faire une boucle pour traiter les lignes
        LeTexte1 = "Bonjour," & vbCrLf & vbCrLf & "Nous vous remercions de bien vouloir nous communiquer les valorisations à fin de mois des valeurs jointes." _
                            & vbCrLf & vbCrLf & "L'information est à nous restituer à l'adresse DINAN GS REFERENTIEL VALEURS@bnpparibas.com:" _
                            & vbCrLf & vbCrLf & "Nous restons à votre disposition." & vbCrLf
    For i = 2 To nblignes
        With Sheets("INVENTAIRE")
            If .Cells(i, "E").Value = "à revoir" Then
                    LeTexte2 = .Cells(i, 1).Value & Space(15) & .Cells(i, 2).Value
                Set Workspace = CreateObject("Notes.NotesUIWorkspace")
                Set Session = CreateObject("notes.NOTESSESSION")
                Set Dir = Session.GETDATABASE("", "")
                    Call Dir.OPENMAIL
                Set Doc = Dir.CREATEDOCUMENT

                Doc.form = "Memo"
                Doc.Subject = "Demande"
                Doc.SendTo = .Cells(i, 5).Value
                Doc.CopyTo = "Loic.guessant@bnpparibas.com"
                Doc.Body = LeTexte1 & vbCrLf & LeTexte2 & vbCrLf & vbCrLf & vbCrLf & "Cordialement."
                Doc.SaveMessageOnSend = True
                    Call Doc.Send(False)
                Set Session = Nothing
                MsgBox "Email sent.", vbOKOnly + vbInformation
                Set Db = Nothing
                Set Doc = Nothing
                Set Workspace = Nothing
                Set EditDoc = Nothing
        End If
    Next i
End Sub
0
LGGUESS Messages postés 8 Statut Membre
 
Merci pour cette proposition qui fonctionne.

Il manque juste une évolution pour ne pas gêner les destinataires.

En effet , il conviendrait de regrouper sur un même email tous les codes + libellés dont l'adresse email est identique

Est-ce possible ?

EXEMPLE :
CODES VALEURS CATEGORIE Adresses Contacts à revoir
QS0003417027" GENEHABITAT 3 Loic.guessant@bnpparibas.com à revoir
FR0010086595 SIMIANE "D" Loic.guessant@bnpparibas.com à revoir
FR0010709493 ELITE LAS FCP basevaleur@rothschild.com à revoir

A nouveau merci pour cette évolution qui va m'être bien utile.
0
Réponse 2 / 3
f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention   1 715
 
Bonjour,

adaptez les colonnes au besoin: 

Sub Bouton416_Cliquer()
    Dim Session As Object
    Dim Dir As Object
    Dim Doc As Object
    Dim Workspace As Object
    Dim EditDoc As Object
    Dim LeTexte1 As String
    Dim LeTexte2 As String
    Dim LeTexteRelance As String
    Dim resp As String
    Dim nblignes As Integer
    Dim Dico_Adr As Object
    Dim PlageD, i, x, TMP, nb, Adr, lig

    'ensuite il suffit de faire une boucle pour traiter les lignes
        LeTexte1 = "Bonjour," & vbCrLf & vbCrLf & "Nous vous remercions de bien vouloir nous communiquer les valorisations à fin de mois des valeurs jointes." _
                            & vbCrLf & vbCrLf & "L'information est à nous restituer à l'adresse DINAN GS REFERENTIEL VALEURS@bnpparibas.com:" _
                            & vbCrLf & vbCrLf & "Nous restons à votre disposition." & vbCrLf
        'Numero unique pour numero de fichier CSV
    Set Dico_Adr = CreateObject("Scripting.Dictionary")
    With Sheets("INVENTAIRE")
        nblignes = Sheets("INVENTAIRE").Range("D2").End(xlDown).Row
        Set PlageD = .Range("D2:D" & nblignes)
        'boucle sur colonne C
        For i = 1 To PlageD.Count
            Dico_Adr(PlageD(i, 1)) = ""
        Next i
        'transfert adresses en tableau
        TMP = Dico_Adr.Keys 'Table sans doublon
    
        For i = 0 To UBound(TMP)
            If TMP(i) <> Empty Then
                Adr = TMP(i): LeTexte2 = ""
                nb = Application.CountIf(PlageD, Adr)
                If nb > 0 Then
                    If nb > 1 Then NL = vbNewLine Else NL = ""
                    For x = 1 To nb
                        lig = 1
                        lig = .Columns(4).Find(Adr, .Cells(lig, 4), , xlWhole).Row
                        If .Cells(lig, "E").Value = "à revoir" Then
                            LeTexte2 = LeTexte2 & .Cells(lig, 1).Value & Space(15) & .Cells(lig, 2).Value & NL
                        End If
                    Set Workspace = CreateObject("Notes.NotesUIWorkspace")
                    Set Session = CreateObject("notes.NOTESSESSION")
                    Set Dir = Session.GETDATABASE("", "")
                        Call Dir.OPENMAIL
                    Set Doc = Dir.CREATEDOCUMENT

                    Doc.form = "Memo"
                    Doc.Subject = "Demande"
                    Doc.SendTo = Adr
                    Doc.CopyTo = "Loic.guessant@bnpparibas.com"
                    Doc.Body = LeTexte1 & vbCrLf & LeTexte2 & vbCrLf & vbCrLf & vbCrLf & "Cordialement."
                    Doc.SaveMessageOnSend = True
                        Call Doc.Send(False)
                    Set Session = Nothing
                    MsgBox "Email sent.", vbOKOnly + vbInformation
                    Set Db = Nothing
                    Set Doc = Nothing
                    Set Workspace = Nothing
                    Set EditDoc = Nothing
                End If
            End If
        Next i
    End With
End Sub
0
LGGUESS Messages postés 8 Statut Membre
 
Bonjour,

Merci pour la réponse

J'ai un souci "erreur de compilation" : End if sans bloc If
0
f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention   1 715 > LGGUESS Messages postés 8 Statut Membre
 
Re,

comme je n'ai pas lotus, j'ai merdu en enlevant les lignes que j'avais mis pour tester 

Sub Bouton416_Cliquer()
    Dim Session As Object
    Dim Dir As Object
    Dim Doc As Object
    Dim Workspace As Object
    Dim EditDoc As Object
    Dim LeTexte1 As String
    Dim LeTexte2 As String
    Dim LeTexteRelance As String
    Dim resp As String
    Dim nblignes As Integer
    Dim Dico_Adr As Object
    Dim PlageD, i, x, TMP, nb, Adr, lig

    'ensuite il suffit de faire une boucle pour traiter les lignes
        LeTexte1 = "Bonjour," & vbCrLf & vbCrLf & "Nous vous remercions de bien vouloir nous communiquer les valorisations à fin de mois des valeurs jointes." _
                            & vbCrLf & vbCrLf & "L'information est à nous restituer à l'adresse DINAN GS REFERENTIEL VALEURS@bnpparibas.com:" _
                            & vbCrLf & vbCrLf & "Nous restons à votre disposition." & vbCrLf
        'Numero unique pour numero de fichier CSV
    Set Dico_Adr = CreateObject("Scripting.Dictionary")
    With Sheets("INVENTAIRE")
        nblignes = Sheets("INVENTAIRE").Range("D2").End(xlDown).Row
        Set PlageD = .Range("D2:D" & nblignes)
        'boucle sur colonne C
        For i = 1 To PlageD.Count
            Dico_Adr(PlageD(i, 1)) = ""
        Next i
        'transfert adresses en tableau
        TMP = Dico_Adr.Keys 'Table sans doublon
    
        For i = 0 To UBound(TMP)
            If TMP(i) <> Empty Then
                Adr = TMP(i): LeTexte2 = ""
                nb = Application.CountIf(PlageD, Adr)
                If nb > 0 Then
                    If nb > 1 Then NL = vbNewLine Else NL = ""
                    For x = 1 To nb
                        lig = 1
                        lig = .Columns(4).Find(Adr, .Cells(lig, 4), , xlWhole).Row
                        If .Cells(lig, "E").Value = "à revoir" Then
                            LeTexte2 = LeTexte2 & .Cells(lig, 1).Value & Space(15) & .Cells(lig, 2).Value & NL
                        End If
                        Set Workspace = CreateObject("Notes.NotesUIWorkspace")
                        Set Session = CreateObject("notes.NOTESSESSION")
                        Set Dir = Session.GETDATABASE("", "")
                            Call Dir.OPENMAIL
                        Set Doc = Dir.CREATEDOCUMENT

                        Doc.form = "Memo"
                        Doc.Subject = "Demande"
                        Doc.SendTo = Adr
                        Doc.CopyTo = "Loic.guessant@bnpparibas.com"
                        Doc.Body = LeTexte1 & vbCrLf & LeTexte2 & vbCrLf & vbCrLf & vbCrLf & "Cordialement."
                        Doc.SaveMessageOnSend = True
                            Call Doc.Send(False)
                        Set Session = Nothing
                            MsgBox "Email sent.", vbOKOnly + vbInformation
                        Set Db = Nothing
                        Set Doc = Nothing
                        Set Workspace = Nothing
                        Set EditDoc = Nothing
                    Next i
                End If
            End If
    End With
End Sub
0
LGGUESS Messages postés 8 Statut Membre
 
Encore merci

mais j'ai un nouveau bug

erreur de compilation

référence de variable de contrôle incorrecte dans Next
0
f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention   1 715 > LGGUESS Messages postés 8 Statut Membre
 
Re, 


Sub Bouton416_Cliquer()
    Dim Session As Object
    Dim Dir As Object
    Dim Doc As Object
    Dim Workspace As Object
    Dim EditDoc As Object
    Dim LeTexte1 As String
    Dim LeTexte2 As String
    Dim LeTexteRelance As String
    Dim resp As String
    Dim nblignes As Integer
    Dim Dico_Adr As Object
    Dim PlageD, i, x, TMP, nb, Adr, lig

    'ensuite il suffit de faire une boucle pour traiter les lignes
        LeTexte1 = "Bonjour," & vbCrLf & vbCrLf & "Nous vous remercions de bien vouloir nous communiquer les valorisations à fin de mois des valeurs jointes." _
                            & vbCrLf & vbCrLf & "L'information est à nous restituer à l'adresse DINAN GS REFERENTIEL VALEURS@bnpparibas.com:" _
                            & vbCrLf & vbCrLf & "Nous restons à votre disposition." & vbCrLf
        'Numero unique pour numero de fichier CSV
    Set Dico_Adr = CreateObject("Scripting.Dictionary")
    With Sheets("INVENTAIRE")
        nblignes = Sheets("INVENTAIRE").Range("D2").End(xlDown).Row
        Set PlageD = .Range("D2:D" & nblignes)
        'boucle sur colonne C
        For i = 1 To PlageD.Count
            Dico_Adr(PlageD(i, 1)) = ""
        Next i
        'transfert adresses en tableau
        TMP = Dico_Adr.Keys 'Table sans doublon
    
        For i = 0 To UBound(TMP)
            If TMP(i) <> Empty Then
                Adr = TMP(i): LeTexte2 = ""
                nb = Application.CountIf(PlageD, Adr)
                If nb > 0 Then
                    If nb > 1 Then NL = vbNewLine Else NL = ""
                    For x = 1 To nb
                        lig = 1
                        lig = .Columns(4).Find(Adr, .Cells(lig, 4), , xlWhole).Row
                        If .Cells(lig, "E").Value = "à revoir" Then
                            LeTexte2 = LeTexte2 & .Cells(lig, 1).Value & Space(15) & .Cells(lig, 2).Value & NL
                        End If
                    Next x
                    Set Workspace = CreateObject("Notes.NotesUIWorkspace")
                    Set Session = CreateObject("notes.NOTESSESSION")
                    Set Dir = Session.GETDATABASE("", "")
                        Call Dir.OPENMAIL
                    Set Doc = Dir.CREATEDOCUMENT

                    Doc.form = "Memo"
                    Doc.Subject = "Demande"
                    Doc.SendTo = Adr
                    Doc.CopyTo = "Loic.guessant@bnpparibas.com"
                    Doc.Body = LeTexte1 & vbCrLf & LeTexte2 & vbCrLf & vbCrLf & vbCrLf & "Cordialement."
                    Doc.SaveMessageOnSend = True
                        Call Doc.Send(False)
                    Set Session = Nothing
                    MsgBox "Email sent.", vbOKOnly + vbInformation
                    Set Db = Nothing
                    Set Doc = Nothing
                    Set Workspace = Nothing
                    Set EditDoc = Nothing
                End If
            End If
        Next i
    End With
End Sub
0
LGGUESS Messages postés 8 Statut Membre
 
Bonjour,

cette version n'est pas ok par rapport à la précédente
voici le code qui permet d'adresser n mails qui fonctionne


Sub Bouton416_Cliquer()
Dim Session As Object
Dim Dir As Object
Dim Doc As Object
Dim Workspace As Object
Dim EditDoc As Object
Dim LeTexte1 As String
Dim LeTexte2 As String
Dim LeTexteRelance As String
Dim resp As String
Dim nblignes As Integer



nblignes = Sheets("INVENTAIRE").Range("Q2").End(xlDown).Row
'ensuite il suffit de faire une boucle pour traiter les lignes
LeTexte1 = "Bonjour," & vbCrLf & vbCrLf & "Nous vous remercions de bien vouloir nous communiquer les valorisations fin de mois des valeurs jointes." _
& vbCrLf & vbCrLf & "L'information est à nous restituer par mail à l'adresse DINAN GS REFERENTIEL VALEURS@bnpparibas.com" _
& vbCrLf & vbCrLf & "Nous vous en remercions et restons à votre disposition." & vbCrLf

For i = 2 To nblignes
With Sheets("INVENTAIRE")
If .Cells(i, "Q").Value = "à revoir" And Cells(i, "P").Value = "mail" And Cells(i, "N").Value <> "Demande NF" Then


LeTexte2 = .Cells(i, 1).Value & Space(15) & .Cells(i, 2).Value
Set Workspace = CreateObject("Notes.NotesUIWorkspace")
Set Session = CreateObject("notes.NOTESSESSION")
Set Dir = Session.GETDATABASE("", "")
Call Dir.OPENMAIL
Set Doc = Dir.CREATEDOCUMENT

Doc.form = "Memo"
Doc.Subject = "Demande de valorisation fin de mois"


Doc.SendTo = .Cells(i, 5).Value

Doc.CopyTo = "Loic.guessant@bnpparibas.com"
Doc.Body = LeTexte1 & vbCrLf & LeTexte2 & vbCrLf & vbCrLf & vbCrLf & "Cordialement."
Doc.SaveMessageOnSend = True
Call Doc.Send(False)
Set Session = Nothing
'MsgBox "Email sent.", vbOKOnly + vbInformation
Set Db = Nothing
Set Doc = Nothing
Set Workspace = Nothing
Set EditDoc = Nothing
Cells(i, 14).Value = "Demande NF"
End If
End With

Next i
End Sub


il manque juste le fait de regrouper les codes + libellés par adresse email pour ne faire qu'un envoi unique par adresse email

CODES VALEURS Adresses Contacts adresse Revoir
QS0003417027GENEHABITAT 3Loic.guessant@bnpparibas.com mail OK
FR0011043314PACHA A1 FCPR alain.l.lucas@bnpparibas.com OK
FR0011043322PACHA A2 FCPR alain.l.lucas@bnpparibas.com OK
FR0010086595SIMIANE "D"Loic.guessant@bnpparibas.com mail à revoir
FR0010086603SIMIANE "C"corinne.gautier@bnpparibas.com mail à revoir
FR0010709493ELITE LAS FCP Loic.guessant@bnpparibas.com mail à revoir
FR0010510834FIP Loic.guessant@bnpparibas.com OK
FR0010590935FIP alain.l.lucas@bnpparibas.com OK
FR0010672261GENCAP Loic.guessant@bnpparibas.com mail à revoir
FR0010713958GENC AVENIR A alain.l.lucas@bnpparibas.com mail à revoir
FR0010788984GENCAP PRIO A corinne.gautier@bnpparibas.com mail à revoir
0
Réponse 3 / 3
f894009 Messages postés 17414 Date d'inscription   Statut Membre Dernière intervention   1 715
 
Re,

pas decide a faire ou vous ne connaissez pas ?????

allez, essayez ca: 

Sub Bouton416_Cliquer()
    Dim Session As Object
    Dim Dir As Object
    Dim Doc As Object
    Dim Workspace As Object
    Dim EditDoc As Object
    Dim LeTexte1 As String
    Dim LeTexte2 As String
    Dim LeTexteRelance As String
    Dim resp As String
    Dim nblignes As Integer
    Dim Dico_Adr As Object
    Dim PlageD, i, x, TMP, nb, Adr, lig

    'ensuite il suffit de faire une boucle pour traiter les lignes
        LeTexte1 = "Bonjour," & vbCrLf & vbCrLf & "Nous vous remercions de bien vouloir nous communiquer les valorisations à fin de mois des valeurs jointes." _
                            & vbCrLf & vbCrLf & "L'information est à nous restituer à l'adresse DINAN GS REFERENTIEL VALEURS@bnpparibas.com:" _
                            & vbCrLf & vbCrLf & "Nous restons à votre disposition." & vbCrLf
        'Numero unique pour numero de fichier CSV
    Set Dico_Adr = CreateObject("Scripting.Dictionary")
    With Sheets("INVENTAIRE")
        nblignes = Sheets("INVENTAIRE").Range("E2").End(xlDown).Row
        Set PlageD = .Range("E2:E" & nblignes)
        'boucle sur colonne C pour liste des adresses sans doublon
        For i = 1 To PlageD.Count
            Dico_Adr(PlageD(i, 1)) = ""
        Next i
        'transfert adresses en tableau
        TMP = Dico_Adr.Keys 'Table sans doublon
        'boucle sur liste adresses
        For i = 0 To UBound(TMP)
            If TMP(i) <> Empty Then     'adresse non vide
                Adr = TMP(i): LeTexte2 = ""
                'recherche combien de fois la meme adresse
                nb = Application.CountIf(PlageD, Adr)
                If nb > 0 Then
                    'si plus d'une fois meme adresse:
                    If nb > 1 Then NL = vbNewLine Else NL = ""
                    'boucle recherche position meme adresse pour regroupement Infos
                    For x = 1 To nb
                        lig = 1: lig = .Columns(5).Find(Adr, .Cells(lig, 5), , xlWhole).Row
                        If .Cells(lig, "Q").Value = "à revoir" And Cells(lig, "P").Value = "mail" And Cells(lig, "N").Value <> "Demande NF" Then
                            LeTexte2 = LeTexte2 & .Cells(lig, 1).Value & Space(15) & .Cells(lig, 2).Value & NL
                            .Cells(lig, 14).Value = "Demande NF"    'ecriture marqueur pour eviter envoi multiples
                        End If
                    Next x
                    'preparation envoi
                    Set Workspace = CreateObject("Notes.NotesUIWorkspace")
                    Set Session = CreateObject("notes.NOTESSESSION")
                    Set Dir = Session.GETDATABASE("", "")
                        Call Dir.OPENMAIL
                    Set Doc = Dir.CREATEDOCUMENT
                    Doc.form = "Memo"
                    Doc.Subject = "Demande de valorisation fin de mois"
                    Doc.SendTo = Adr
                    Doc.CopyTo = "Loic.guessant@bnpparibas.com"
                    Doc.Body = LeTexte1 & vbCrLf & LeTexte2 & vbCrLf & vbCrLf & vbCrLf & "Cordialement."
                    Doc.SaveMessageOnSend = True
                    Call Doc.Send(False)
                    Set Session = Nothing
                    'MsgBox "Email sent.", vbOKOnly + vbInformation
                    Set Db = Nothing
                    Set Doc = Nothing
                    Set Workspace = Nothing
                    Set EditDoc = Nothing
                End If
            End If
        Next i
    End With
End Sub
0

Discussions similaires

Rétrodiffusion "Mail Delivery System"
baissaoui -
baissaoui -

0 réponse
Echec d'envoi message sur Messenger
Kris68 -
Colibri -

2 réponses