Envoi mail plusieurs destinataires (excel)

Envoi mail plusieurs destinataires (excel) - VB/VBA/VBS - Programmation

Marsh Posté le 25-11-2010 à 00:36:07    

Salut  
 
je souhaite envoyer un mail type à plusieurs destinataires via Excel.  
Les destinataires se trouvent dans une colonne E.  
Dans la colonne F j'indique oui ou non. (oui = envoi mail)
Le problème est que j'ai un mail par destinataire ce qui est impossible à gérer. Je souhaiterai que toutes les adresses mail de la colonne E soient en destinataire dans un seul e-mail.  
 
Voici mon code :
 
 
 
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
 
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application" )
 
    On Error GoTo cleanup
         
   
   For Each cell In Columns("E" ).Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "F" ).Value) = "oui" Then
 
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "Infos"
                .Body = "Bonjour, xxxxxxxxxxxxxx"
                .Display
                 
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next cell
 
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub
 
J'espère que je suis assez clair ^^
Par avance, merci.  

Reply

Marsh Posté le 25-11-2010 à 00:36:07   

Reply

Marsh Posté le 25-11-2010 à 07:31:30    

Hello,
 
je sais pas si ça marche mais essaie en envoyant un tableau a OutMail.To avec les adresses de tous les destinataires. Quelque chose comme ça :
 
   

Code :
  1. Dim OutApp As Object
  2.     Dim OutMail As Object
  3.     Dim cell As Range   
  4.     Dim tableauDestinataires() as String
  5.     Dim nbDestinataires as Integer
  6.     nbDestinataires = 0
  7.     Application.ScreenUpdating = False
  8.     Set OutApp = CreateObject("Outlook.Application" )
  9.     On Error GoTo cleanup
  10.        
  11.    
  12.    For Each cell In Columns("E" ).Cells.SpecialCells(xlCellTypeConstants)
  13.         If cell.Value Like "?*@?*.?*" And _
  14.            LCase(Cells(cell.Row, "F" ).Value) = "oui" Then
  15.                Redim Preserve tableauDestinataires(nbDestinataires)
  16.                tableauDestinataires(nbDestinataires) = cell.value
  17.                nbDestinataires = nbDestinataires + 1
  18.         End If
  19.     Next cell
  20.  
  21.             Set OutMail = OutApp.CreateItem(0)
  22.             On Error Resume Next
  23.             With OutMail
  24.                 .To = tableauDestinataires
  25.                 .Subject = "Infos"
  26.                 .Body = "Bonjour, xxxxxxxxxxxxxx"
  27.                 .Display
  28.                
  29.             End With
  30.             On Error GoTo 0
  31.             Set OutMail = Nothing
  32. cleanup:
  33.     Set OutApp = Nothing
  34.     Application.ScreenUpdating = True
  35. End Sub


Message édité par Arwon le 25-11-2010 à 07:31:55
Reply

Marsh Posté le 25-11-2010 à 09:45:33    

Merci. ça fonctionne très bien.  
C'est sympa.  
 
Bonne journée

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed