envoi de mail lotus notes ien boucle via condition sous excel Fermé

Question

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

f894009 · Answer

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

f894009 · Answer

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

f894009 · Answer

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

Envoi de mail lotus notes ien boucle via condition sous excel

3 réponses