VB et les adresses mails

Bonjour, j'ai écrit le code ci dessous pour envoyer automatiquement des mails à des adresses situés dans une colonne Excel.
Mais j'ai un message d'erreur car j'ai trop d'adresses.
J' ai donc fait 2 boutons pour séparer la liste d'adresse en 2,mais
si une adresse est présente dans la première partie de la colonne il la reprend dans le deuxième envoi.
Qd je n'avai qu'un mail il ne prenait pas les doublons ???
Premier code:

Sub MailsCciaux()
Dim obj As String
Dim mes As String
Dim myStr As String
For i = 3 To 82
If InStr(myStr, Trim(Cells(i, 11))) = 0 Then
myStr = myStr & Cells(i, 11) & ";"
End If
Next
myStr = Left(myStr, Len(myStr) - 1)
obj = InputBox("Objet du message")
mess = InputBox("Entrer le message")
adresse = myStr
URLto = "mailto:" & adresse & "?subject=" & obj & "&body=" & mess
ActiveWorkbook.FollowHyperlink Address:=URLto

End Sub

Deuxième code:

Sub MailsCciaux2()
Dim obj As String
Dim mes As String
Dim myStr As String
For i = 83 To 160
If InStr(myStr, Trim(Cells(i, 11))) = 0 Then
myStr = myStr & Cells(i, 11) & ";"
End If
Next
myStr = Left(myStr, Len(myStr) - 1)
obj = InputBox("Objet du message")
mess = InputBox("Entrer le message")
adresse = myStr
URLto = "mailto:" & adresse & "?subject=" & obj & "&body=" & mess
ActiveWorkbook.FollowHyperlink Address:=URLto

End Sub

Merci

Comme ça, non.
Mais par contre, tu peux vérifier s'il y a bien un '@'.

Je voudrai savoir si tu connais la syntaxe pour définir un lien hypertexte.
par ex au lieu d'avoir ça:
If InStr(myStr, Trim(Cells(i, 9))) = 0 And Trim(Cells(i, 9).Font.ColorIndex) <> -4105 Then
je voudrai avoir:
If Instr(myStr,Trim(Cells(i,9)))=0 And 'le mot est un lien hypertexte' Then
cad qu'il n'envoie le mail que si l'adresse est un lien hypertexte
Merci

Merci HDU, en fait ce sont ces lignes la qui n'allaient pas:

If InStr(myStr, Trim(Cells(i, 9))) = 0 Then
If Trim(Cells(i, 9).Font.ColorIndex) <> -4105 Then

Il fallait mettre:
If InStr(myStr, Trim(Cells(i, 9))) = 0 And Trim(Cells(i, 9).Font.ColorIndex) <> -4105 Then

Sinon il ne prenait pas en compte la première partie de la condition et il envoyait les doublons
Merci

Tu peux remettre tout ton code, ou le mieux, c que tu me l'envoies par mail avec la feuille de calcul, voir ou ça merde...
Adresse : voir profil.

Il s'agit en effet du code -4105
Par contre je rencontre un Pb très bizarre:
Il envoie en mail avec uniquement l'adresse 9 (sans copie) autant de fois qu'il y a une adresse dans la couleur auto(-4105)
cad que si j'ai 4 adresses en couleur auto de suite, ensuite il va envoyer 4 mails avec juste l'adresse 9 (sans copie) avant d'envoyer le mail avec la copie ???????
(Ce n'est pas un Pb de couleur car c'est la même chose avce d'autres couleurs)

Salut !
Le NOIR est bien codé sur 1, mais si c'est noir.
Si ça ne passe pas, il s'agit vraissemblablement de la couleur AUTOMATIQUE d'excel, définie elle sur -4105 (moins 4105).
@+

Ci-dessous mon code, avec la condition de couleur mais elle n'agit pas sur le résultat ?
Sub SendMail()
Dim obj As String
Dim mes As String
Dim myStr As String
Dim myStr1 As String
obj = InputBox("Objet du message")
mes = InputBox("Entrer le message")

For i = 5 To 130
If InStr(myStr, Trim(Cells(i, 9))) = 0 Then
If Trim(Cells(i, 9).Font.ColorIndex) <> 1 Then
myStr = Cells(i, 9)
If InStr(myStr1, Trim(Cells(i, 6))) = 0 Then
myStr1 = Cells(i, 6)
End If
End If
myStr = Left(myStr, Len(myStr))
myStr1 = Left(myStr1, Len(myStr1))
adresse = myStr
copie = myStr1
URLto = "mailto:" & adresse & "?subject=" & obj & "&body=" & mes & "&Cc=" & copie
ActiveWorkbook.FollowHyperlink Address:=URLto

myStr1 = ""

End If
Next
End Sub

La couleur noire est codée par le 1 ?
Jai essayé ce code et dans ma colonne , j'ai des adresses en noir qu'il essaie de lancer qd même ?

Il suffit de rajouter une condition :
if Trim(Cells(i, 33).Font.ColorIndex)<>1 then
.......

@+

Sinon je voudrai indiquer une condition: qu'il ne lance pas le mail si la couleur d'écriture des adresses dans "mystr " est noire ?

Il ne met aucune adresse dans le destinataire Outlook pour aucun mail
Il met uniquement les copies

Bizazrre, ça marche chez moi...
Je ne pense pas qu'il faille enlever ces 2 lignes, au contraire.
La logique de ce que je t'ai mis c'est :
on regarde si les cellules (i,13) et (i,17) contiennent qqc
si oui alors on crée le message
sinon on fait rien
on remet a 0 les variables
on continue depuis le début à la ligne suivante

Ca doit marcher...
@+

Je n'ai pas réussi avec ta méthode mais
En fait le mieux est d'enlever 2 lignes de code à la fin:
myStr=""
myStr1=""
Ce qui permet d'enlever tous les mails ou l'adresse ou la copie est vide.
Le problème c 'est qu'il prend comme copie la dernière adresse(colonne17) utlisée avec une adresse (colonne13) valide utlisée si la cellule de la colonne 17 est vide.

Simple, il te faut juste concaténer tes conditions en une seule :

For i = 4 To 10
If InStr("@", Trim(Cells(i, 13))) = 0 And InStr("@", Trim(Cells(i, 17))) = 0 Then
myStr = Cells(i, 13)
myStr1 = Cells(i, 17)
myStr = Left(myStr, Len(myStr))
myStr1 = Left(myStr1, Len(myStr1))
adresse = myStr
copie = myStr1
URLto = "mailto:" & adresse & "?subject=" & obj & "&body=" & mes & "&Cc=" & copie
ActiveWorkbook.FollowHyperlink Address:=URLto
myStr = ""
myStr1 = ""
End If

Next

@+

Merci j'ai essayé , ça marche.
Dis moi est ce que tu saurais quel code rajouter de manière à ce que qd soit la ligne 13 soit la ligne 17 est vide il n'essaie pas d'envoyer un mail ?

En fait les ";" c'est parceque je voulai automatiser cette opération mais je ne pense pas que ce soit posible en envoyant un mail à chaque adresse ?
Merci

Merde, je viens d'essayer ma soluce et c une grosse connerie.
Y'a un truc que je ne comprends pas, pourkoi tu rajoutes un ";" à chaque fois si c pour envoyer autant de message que d'adresse ???
Voili, j'ai refait et là ça marche :

Sub SendMails()
Dim obj As String
Dim mes As String
Dim myStr As String
Dim myStr1 As String
obj = InputBox("Objet du message")
mes = InputBox("Entrer le message")


For i = 4 To 10
If InStr("@", Trim(Cells(i, 13))) = 0 Then
myStr = Cells(i, 13)
If InStr("@", Trim(Cells(i, 17))) = 0 Then
myStr1 = Cells(i, 17)
End If
myStr = Left(myStr, Len(myStr))
myStr1 = Left(myStr1, Len(myStr1))
adresse = myStr
copie = myStr1
URLto = "mailto:" & adresse & "?subject=" & obj & "&body=" & mes & "&Cc=" & copie
ActiveWorkbook.FollowHyperlink Address:=URLto
myStr = ""
myStr1 = ""
End If

Next
End Sub

@+

Merci ton idée est bonne
mais le Pb c'est qu'il ajoute les adresses mails
pae ex: il va envoyer à : Cell(1,13)+Cell(2,13)
ave en copie: Cell(1,17)+Cell(2,17)
Et je voudrai qu'il fasse 2 mails différents
De plus qd il tombe sur une cellule vide, il essaie d'envoyer un mail
Merci

Bon, pour qu'il te crée un nouveau mail à chaque adresse trouvée, il faut que la création de message se fasse dans ta boucle, pas en dehors.
Ce qui, concrétement, te donne ça :

Dim obj As String
Dim mes As String
Dim myStr As String
Dim myStr1 As String
obj = InputBox("Objet du message")
mes = InputBox("Entrer le message")


For i = 5 To 100
If InStr(myStr, Trim(Cells(i, 13))) = 0 Then
myStr = myStr & Cells(i, 13) & ";"
If InStr(myStr1, Trim(Cells(i, 17))) = 0 Then
myStr1 = myStr1 & Cells(i, 17) & ";"
End If
myStr = Left(myStr, Len(myStr))
myStr1 = Left(myStr1, Len(myStr1))
adresse = myStr
copie = myStr1
URLto = "mailto:" & adresse & "?subject=" & obj & "&body=" & mes & "&Cc=" & copie
ActiveWorkbook.FollowHyperlink Address:=URLto
End If

Next

@+

C'est un message unique envoyé à toutes les adresses trouvées
mais la solution que j'ai trouvé pour que dans chaque mail n'apparaisse que les 2 adresses de la même ligne
c'est d'envoyer un mail différent à chaque adresse
Mais j'ai ce Pb (cf ci dessus):
Pb avec les cellules vides
Pb qd il rencontre une autre adresse il l'ajoute dan le mail au lieu de creer un nouveau mail ?
Merci