1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73
| Sub envoi_mail()
'Faire une boucle
For k = 0 To 100
' si la cellule Cells(k + 2, 2) est vide, on arrete
If Sheets("Messages").Cells(k + 2, 2) = "" Then
Exit For
End If
Next k
'pour toute les valeurs de k :
For i = 2 To k + 1
'Initialiser la variable au début de la boucle
corps_mail = ""
'on crée 2 objets
Dim ol As Object, NOUVEAU_MESSAGE As Object
Dim strBody As String
'ol contient les fonctions d'outlook
Set ol = CreateObject("outlook.application")
Set NOUVEAU_MESSAGE = ol.CreateItem(olMailItem)
courriel_De = Sheets("Messages").Cells(i, 1)
titre_mail = Sheets("Messages").Cells(i, 4)
courriel_to = Sheets("Messages").Cells(i, 2)
courriel_cc = Sheets("Messages").Cells(i, 3)
'Cela permet de concatener les differentes valeurs (corps_mail = corps_mail & Sheets).
corps_mail = corps_mail & Sheets("Messages").Cells(i, 5) & Chr(10)
corps_mail = corps_mail & Sheets("Messages").Cells(i, 6) & Chr(10)
corps_mail = corps_mail & Sheets("Messages").Cells(i, 7) & Chr(10)
corps_mail = corps_mail & Sheets("Messages").Cells(i, 8) & Chr(10)
corps_mail = corps_mail & Sheets("Messages").Cells(i, 9) & Chr(10)
corps_mail = corps_mail & Sheets("Messages").Cells(i, 10) & Chr(10)
corps_mail = corps_mail & Sheets("Messages").Cells(i, 11) & Chr(10)
corps_mail = corps_mail & Sheets("Messages").Cells(i, 12) & Chr(10)
corps_mail = corps_mail & Sheets("Messages").Cells(i, 13) & Chr(10)
corps_mail = corps_mail & Sheets("Messages").Cells(i, 14) & Chr(10)
corps_mail = corps_mail & Sheets("Messages").Cells(i, 15) & Chr(10)
corps_mail = corps_mail & Sheets("Messages").Cells(i, 16) & Chr(10)
corps_mail = corps_mail & Sheets("Messages").Cells(i, 17) & Chr(10)
corps_mail = corps_mail & Sheets("Messages").Cells(i, 18) & Chr(10)
corps_mail = corps_mail & Sheets("Messages").Cells(i, 19) & Chr(10)
corps_mail = corps_mail & Sheets("Messages").Cells(i, 20) & Chr(10)
corps_mail = corps_mail & Sheets("Messages").Cells(i, 21) & Chr(10)
corps_mail = corps_mail & Sheets("Messages").Cells(i, 22) & Chr(10)
NOUVEAU_MESSAGE.De = courriel_De
NOUVEAU_MESSAGE.To = courriel_to
NOUVEAU_MESSAGE.Subject = titre_mail
NOUVEAU_MESSAGE.cc = courriel_cc
NOUVEAU_MESSAGE.Body = corps_mail
NOUVEAU_MESSAGE.Display
Application.Wait (Now + TimeValue("00:00:02"))
'on clique sur "entrer"
SendKeys "^{ENTER}", True
Application.Wait (Now + TimeValue("00:00:04"))
'on detruit notre message dans la mémoire vive
Set ol = Nothing
Set NOUVEAU_MESSAGE = Nothing
Next i
End Sub |
Partager