VB et les adresses mails Fermé

Question

Bonjour,
Je veux envoyer un mail aux adresses de la colonne 13 copie les adresses de la colonne17.
Le CODE ci desssous permet d'envoyer les mails mais qd il recontre une cellule vide , ilr eprend la dernière adresse
De plus qd il recontre une nouvelle adresse , au lieu d'envoyer un mail à cette adresse , il l'ajoute à l'adresse précedent dans le même mail.
Si qqun pouvait me filer un coup de main , ce serait cool
Merci

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 = 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
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
Next
End Sub

Utilisateur anonyme · Answer

A pas tout compris ???Tu veux quoi : un message par adresse trouvée sur chaque ligne, ou un message unique envoyé à toutes les adresses trouvées ?

romsec · Answer

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

Utilisateur anonyme · Answer

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

@+

romsec · Answer

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

Utilisateur anonyme · Answer

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

@+

romsec · Answer

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

Utilisateur anonyme · Answer

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

@+

romsec · Answer

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.

Utilisateur anonyme · Answer

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

romsec · Answer

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

romsec · Answer

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

Utilisateur anonyme · Answer

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

romsec · Answer

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 ?

romsec · Answer

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

Utilisateur anonyme · Answer

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

romsec · Answer

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)

Utilisateur anonyme · Answer

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.

romsec · Answer

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

romsec · Answer

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

Utilisateur anonyme · Answer

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

romsec · Answer

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

VB et les adresses mails

21 réponses

Discussions similaires