A toutes et tous, bonjour !
Je dispose d'un fichier K:\Rappro\R01.xls de qques 10aines de lignes d'infos nominatives contenant des adresses mail en col C.
Je souhaite:
1/ vérifier la présence d'un mail valide pour chaque cellule Cx,
2/ et, si une adresse mail valide est présente, envoyer un mail via Outlook avec pour objet le contenu d'une cellule prédéfinie de la feuille en cours (E1), et en corps de texte le contenu d'un fichier txt K:\Rappro\Offre.txt (idéalement) ou bien le contenu d'une plage de cellules F1:F5
3/ répéter l'opération jusqu'à la fin du fichier!
Important: même si le contenu est identique, chaque destinataire reçoit son propre mail, la mention des autres destinataires ne devant pas apparaître dans le message
Grand merci d'avance
K.
Voici un exemple (fichier R01.xls et code)
A B C D E F
1 nom1 info1 mail1 X 12345 ligne1
2 nom2 info2 mail2 ligne2
3 nom2 info3 (vide) X ligne3
4 nom4 info4 mail4 ligne4
5 nom5 info5 (vide)
Sub mail()
Dim sujet As String
sujet = "Offre de service = " & Range("E1")
Dim body1 As String
body1 = Range("F1")
Dim body2 As String
body2 = Range("F2")
Dim body3 As String
body3 = Range("F3")
Dim body4 As String
body4 = Range("F4")
i = 1
cell = ""
Do
If Range("D" & i).Value = "X" Then
cell = cell & Range("C" & i).Value
hyperlien = "mailto:" & cell & "?subject=" & sujet & "&body=" & body1 & _ vbNewLine & body2 & vbNewLine & body3 & vbNewLine & body4
ActiveWorkbook.FollowHyperlink hyperlien
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "%s"
'Application.SendKeys "%s"
End If
i = i + 1
cell = ""
hyperlien = ""
Loop Until Range("A" & i).Value = ""
End Sub
Ce script fonctionne +/- bien:
1/ il prend les infos col F pour le corps du mail (mais sans saut de ligne même si j'utilise & vbCrLf ou vbNewLine ou & CHR(13) !!!). Cependant, je préfererai qu'il ouvre et prenne le contenu d'un fichier.txt (même DIR)
2/ Il ouvre seulement un nouveau message, je souhaiterai qu'il le crée, le ferme et l'installe dans la boîte d'envoi, prêt à partir (pb avec le sendkeys ?)
3/ et, idéalement, je souhaiterai associer une PJ (pj.txt (même DIR)
Un petit coup de main serait le bienvenu ...
Merci
k
Je dispose d'un fichier K:\Rappro\R01.xls de qques 10aines de lignes d'infos nominatives contenant des adresses mail en col C.
Je souhaite:
1/ vérifier la présence d'un mail valide pour chaque cellule Cx,
2/ et, si une adresse mail valide est présente, envoyer un mail via Outlook avec pour objet le contenu d'une cellule prédéfinie de la feuille en cours (E1), et en corps de texte le contenu d'un fichier txt K:\Rappro\Offre.txt (idéalement) ou bien le contenu d'une plage de cellules F1:F5
3/ répéter l'opération jusqu'à la fin du fichier!
Important: même si le contenu est identique, chaque destinataire reçoit son propre mail, la mention des autres destinataires ne devant pas apparaître dans le message
Grand merci d'avance
K.
Voici un exemple (fichier R01.xls et code)
A B C D E F
1 nom1 info1 mail1 X 12345 ligne1
2 nom2 info2 mail2 ligne2
3 nom2 info3 (vide) X ligne3
4 nom4 info4 mail4 ligne4
5 nom5 info5 (vide)
Sub mail()
Dim sujet As String
sujet = "Offre de service = " & Range("E1")
Dim body1 As String
body1 = Range("F1")
Dim body2 As String
body2 = Range("F2")
Dim body3 As String
body3 = Range("F3")
Dim body4 As String
body4 = Range("F4")
i = 1
cell = ""
Do
If Range("D" & i).Value = "X" Then
cell = cell & Range("C" & i).Value
hyperlien = "mailto:" & cell & "?subject=" & sujet & "&body=" & body1 & _ vbNewLine & body2 & vbNewLine & body3 & vbNewLine & body4
ActiveWorkbook.FollowHyperlink hyperlien
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "%s"
'Application.SendKeys "%s"
End If
i = i + 1
cell = ""
hyperlien = ""
Loop Until Range("A" & i).Value = ""
End Sub
Ce script fonctionne +/- bien:
1/ il prend les infos col F pour le corps du mail (mais sans saut de ligne même si j'utilise & vbCrLf ou vbNewLine ou & CHR(13) !!!). Cependant, je préfererai qu'il ouvre et prenne le contenu d'un fichier.txt (même DIR)
2/ Il ouvre seulement un nouveau message, je souhaiterai qu'il le crée, le ferme et l'installe dans la boîte d'envoi, prêt à partir (pb avec le sendkeys ?)
3/ et, idéalement, je souhaiterai associer une PJ (pj.txt (même DIR)
Un petit coup de main serait le bienvenu ...
Merci
k
