envoir de mail + 1 personne en copie

Question

Bonjour,

J'ai un code qui envoie un mail a qulqu'un qui se trouve en cellule (i, 14). Je veux que ce mail aille aussi a une personne en copie en cellule (i,15).

Voici mon code de depart + en rouge mon ajout (non finalisé)
tableausuivi2(i - 7 - counter, 5) = ActiveSheet.Cells(i, 14)
tableausuivi2(i - 7 - counter, 6) = ActiveSheet.Cells(i, 15)

...

MailAd = tableausuivi(i, 5)


If MailAd <> "" Then
   
   Set omessage = osession.Outbox.Messages.Add
   omessage.Subject = "RELANCE/REMINDER Supplier : " & tableausuivi(i, 0)
   Set oRecip = omessage.Recipients.Add(MailAd)
   oRecip.Resolve
      omessage.Text = message
  omessage.Send True
  

Je ne connais pas la fonction pour mettre en copie, merci de m'indiquer comment faire.

a+.

NeuroCypher · Answer

Eh bien tu fais autant de Recipients.Add(MailAd) que tu veux de destinataires...

NeuroCypher

kikou6969 · Answer

Cette deuxieme adresse mail ne doit pas etre destiantaire principal (ou direct) du mail mais doit etre en copie (le CC dans outlook).

Je ne pense pas que se soit la meme fonction.

NeuroCypher · Answer

....
Set oRecip = omessage.Recipients.Add(MailAd)
oRecip.Type = olTo

Set oRecipCC = omessage.Recipients.Add(MailAdCC)
oRecipCC.Type = olCC

oRecip.Resolve
....

<hr size="2" width="100%" />NeuroCypher

kikou6969 · Answer

Merci pour ta reponse.

Mais ca ne marche pas -> debogage  Erreur d'execusion '448' Argument nommé introuvable

Quand je clic sur debogage, la ligne ci-dessous aparait en jaune:
oRecip.Type = olTo

cs_MPi · Answer

Pourrais-tu me dire ce que tu utilises comme méthode pour l'envoi ?
Je ne vois ce que peut être omessage, osession, outbox,... (?)

Ce n'est pas Outlook ni MAPI à ce que je peux voir...
As-tu besoin de joindre des fichiers à tes envois ?

MPi²

kikou6969 · Answer

Bonjour, Voici mon code, je pense que ca repondra a toutes tes questions ;) Sub relance() Dim nb As Integer Dim tableausuivi2() nb = CInt(InputBox("nbre de lignes ?")) + 1 dimtableau = nb - 5 counter = 0 ReDim Preserve tableausuivi2(0 To (nb - 5), 6) For i = 5 To nb resultat = False For k = 0 To UBound(tableausuivi2) If fittaille(ActiveSheet.Cells(i, 3)) = tableausuivi2(k, 1) Then If fittaille(ActiveSheet.Cells(i, 1)) = tableausuivi2(k, 0) Then resultat = True dimtableau = dimtableau - 1 counter = counter + 1 Exit For Else resultat = False End If Else resultat = False End If Next k If ActiveSheet.Cells(i, 8) "RECEIVED" And ActiveSheet.Cells(i, 9) "RECEIVED" And ActiveSheet.Cells(i, 10) = "RECEIVED" Then resultat = True dimtableau = dimtableau - 1 counter = counter + 1 End If If resultat = False Then tableausuivi2(i - 5 - counter, 0) = fittaille(ActiveSheet.Cells(i, 1)) tableausuivi2(i - 5 - counter, 1) = fittaille(ActiveSheet.Cells(i, 3)) tableausuivi2(i - 5 - counter, 2) = fittaille(ActiveSheet.Cells(i, 8)) tableausuivi2(i - 5 - counter, 3) = fittaille(ActiveSheet.Cells(i, 9)) tableausuivi2(i - 5 - counter, 4) = fittaille(ActiveSheet.Cells(i, 10)) tableausuivi2(i - 5 - counter, 5) = ActiveSheet.Cells(i, 14) tableausuivi2(i - 5 - counter, 6) = ActiveSheet.Cells(i, 15) End If Next tableausuivi = tableausuivi2 Set appword = CreateObject("Word.Application") WordBasic.sortarray tableausuivi Dim osession As MAPI.Session Dim omessage As message Dim oRecip As Recipient Set osession = CreateObject("MAPI.Session") osession.Logon Dim message As String message = "CI DESSOUS UN RESUME DES REFERENCES EN COURS " & vbCrLf & " POUR CHAQUE REFERENCE EST INDIQUE SOIT RECU SOIT LE NOMBRE DE JOURS RESTANT " & vbCrLf & " AVANT EMBARQUEMENT(SI INFO DISPONIBLE) MERCI DANS CE CAS DE NOUS FAIRE PARVENIR LES ELEMENTS AU PLUS VITE " & vbCrLf & vbCrLf & " HERE IS THE SUM UP OF THE REFERENCES FOLLOWED BY US, " & vbCrLf & " FOR EACH ELEMENTS YOU WILL SEE EITHER RECEIVED OR NOT RECEIVED " & vbCrLf & " WITH THE NUMBER OF DAYS MISSING TILL SHIPMENT IF AVAILABLE " & vbCrLf & " PLEASE SEND ASAP THE MISSING ELEMENTS " & vbCrLf & vbCrLf & vbCrLf & " FOURNISSEUR" & " " & " REFERENCE" & " " & " TECHNICAL FILE " & " " & " LAB TESTS" & " " & " CONFORMITY SAMPLES" & vbCrLf Dim MailAd As String Dim Msg As String Dim Subj As String Dim URLto As String For i = 0 To dimtableau Count = 0 k = i + 1 If k > dimtableau Then Exit For Do Until k = dimtableau If tableausuivi(k, 0) = tableausuivi(i, 0) Then message = message & vbCrLf & tableausuivi(k, 0) & " " & tableausuivi(k, 1) & " " & tableausuivi(k, 2) & " " & tableausuivi(k, 3) & " " & tableausuivi(k, 4) & " Days left" Count = Count + 1 End If k = k + 1 Loop message = message & vbCrLf & tableausuivi(i, 0) & " " & tableausuivi(i, 1) & " " & tableausuivi(i, 2) & " " & tableausuivi(i, 3) & " " & tableausuivi(i, 4) & " Days left" MailAd = tableausuivi(i, 5) MailAdCC = tableausuivi(i, 6) If MailAd <> "" Then Set omessage = osession.Outbox.Messages.Add omessage.Subject = "RELANCE/REMINDER Supplier : " & tableausuivi(i, 0) Set oRecip = omessage.Recipients.Add(MailAd) oRecip.Type = olTo oRecip.Resolve Set oRecipCC = omessage.Recipients.Add(MailAdCC) oRecipCC.Type = olCC oRecipCC.Resolve omessage.Text = message omessage.Send True End If message = "CI DESSOUS UN RESUME DES REFERENCES EN COURS " & vbCrLf & " POUR CHAQUE REFERENCE EST INDIQUE SOIT RECU SOIT LE NOMBRE DE JOURS RESTANT " & vbCrLf & " AVANT EMBARQUEMENT(SI INFO DISPONIBLE) MERCI DANS CE CAS DE NOUS FAIRE PARVENIR LES ELEMENTS AU PLUS VITE " & vbCrLf & "SI TOUT A ETE RECU VOUS POUVEZ IGNORER CE MAIL" & vbCrLf & vbCrLf & " HERE IS THE SUM UP OF THE REFERENCES FOLLOWED BY US, " & vbCrLf & " FOR EACH ELEMENTS YOU WILL SEE EITHER RECEIVED OR NOT RECEIVED " & vbCrLf & " WITH THE NUMBER OF DAYS MISSING TILL SHIPMENT IF AVAILABLE " & vbCrLf & " PLEASE SEND ASAP THE MISSING ELEMENTS " & vbCrLf & "IF EVERYTHING WAS RECEIVED YOU CAN IGNORE THIS MAIL" & vbCrLf & vbCrLf & vbCrLf & " FOURNISSEUR" & " " & " REFERENCE" & " " & " TECHNICAL FILE " & " " & " LAB TESTS" & " " & " CONFORMITY SAMPLES" & vbCrLf i = i + Count Next osession.Logoff End Sub Public Function fittaille(ByRef reference2 As String) As String Reference = Trim(reference2) If Len(Reference) < 12 Then For i = 1 To 12 - Len(Reference) Reference = Reference & " " Next Else Reference = Left(Reference, 12) End If fittaille = CStr(Reference) End Function Pas besoin de joindre des fichiers et j'utilise bien oultook version 2002.

cs_MPi · Answer

Si tu utilises MAPI, regarde cet exemple de M$

Note: je ne sais pas si c'est à cause de différentes versions de MAPI, mais certains codes que je vois comportent des termes que je ne retrouve pas dans ma version ou mes tests... comme logoff ici (moi j'utilise signoff)

Faut dire que j'utilise les contrôles MAPI ...

Tu aurais aussi pu passer directement par Outlook ou utiliser ShellExecute, mais çe dernier affiche la boîte d'envoi plutôt que de l'envoyer en "background", il me semble.

MPi²

kikou6969 · Answer

Je ne sais pas ce qu'est MAPI, aparement c'est un logiciel de programation.

Moi j'utilise le Visual basic Editor 6.3 de Excell.

cs_MPi · Answer

Bon OK, je comprends un peu mieux...

Ne pourrais-tu pas passer par des objets Outlook au lieu de cette méthode ? 
Est-ce que tous ceux qui utiliseront ton programme possèdent Outlook ?

MPi²

kikou6969 · Answer

Bonjour mpi,

Pour passer par des objets outlook au lieu de cette methode, pourquoi pas du moment que ca marche :)
En fait j'etais partit sur cette methode car je connais un peu de visual basic et qu'un pote m'a montrer ou se trouvait virtual basic editor de excell :)

Et oui tous ceux qui utilise ma macro ont outlook. En fait il n'y a que moi et mon assistante qui l'utilisons :)

cs_MPi · Answer

Autres questions avant de trop m'avancer...

Est-ce que tu veux que le message s'envoie en transparence ?
C'est-à-dire est-ce que ça dérange de voir apparaître la boîte d'envoi et cliquer le bouton "Envoyer" ? Ou préfères-tu que tout se passe sans que tu n'y vois rien ?

MPi²

kikou6969 · Answer

Je prefere que le message s'envoie en transaparence car ce programme me permet d'envoyer 100 à 150 mails d'un coup (Donc appuyer 100 à 150 fois sur envoyé ... c'est pas l'ideal).

Voila, si t'as d'autres questions, n'hesites pas ;)

cs_MPi · Answer

Voici une base.
Il te suffira de remplacer les valeurs en bleu par ce que ton programme génère ou nécessite. Si tu dois utiliser des polices particulières, plutôt que d'utiliser Body, utilise HTMLBody, mais il faudra convertir certains caractères comme les sauts de ligne et autres..
Il faut aussi que tu actives la référence à Outlook (menu Outils)

    'Crée un objet Outlook
    Dim OutlookApp As New Outlook.Application
    Dim NewMail As Outlook.MailItem
    
    'Création de l'objet message
    Set NewMail = OutlookApp.CreateItem(olMailItem)
    
    NewMail.To = MaListeA
    NewMail.CC = MaListeCC
    NewMail.BCC = MalisteInvisible     'CCI au besoin
    NewMail.Subject = "L'objet de l'envoi"
    NewMail.Body = "Ce qu'il faut écrire dans le corps du message"
    
    NewMail.Send      ' et c'est parti
    'NewMail.Display  'à mettre au lieu de Send pour tester sans envoyer 

MPi²

kikou6969 · Answer

Cela ne marche pas car dans le body, c'est une boucle et pas toujours le meme texte.

cs_MPi · Answer

Tu dois donc créer une boucle qui stocke dans une variable ce qu'il y a à écrire et envoyer cette variable...

ex:
For i = 0 to Ubound(MonTablo)  ' ici tu mets la boucle nécessaire
    strTemp = strTemp & MonTablo(I) & vbcrlf
Next
NewMail.Body = strTemp

MPi²

Envoir de mail + 1 personne en copie

15 réponses

Votre réponse

Discussions similaires