VB et les adresses mails

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 - Page 2

Discussions similaires

Newsletters