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+.

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

NeuroCypher

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.

....
Set oRecip = omessage.Recipients.Add(MailAd)
oRecip.Type = olTo

Set oRecipCC = omessage.Recipients.Add(MailAdCC)
oRecipCC.Type = olCC

oRecip.Resolve
....

---

NeuroCypher

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

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²

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.

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²

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.

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²