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 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99
| Sub envoi_mail()
envoi = 0
Sheets("Intro").Range("E8").Value = ""
'Mettre "ok" ligne 8 colonne 4 sinon le MsgBox s'affiche
If Sheets("Liste_des_messages").Cells(8, 4) = "" Then
MsgBox "Veuillez d'abord valider que les fiches sont bien à la bonne date, colonne E"
Exit Sub
End If
' k represente le nombre de message à envoyer
For k = 0 To 1000
' si la cellule Cells(k + 2, 2) est vide, on arrete
If Sheets("Liste_des_messages").Cells(k + 2, 2) = "" Then
Exit For
End If
Next k
' on réinitialise l'affichage de l'avancement
Sheets("Intro").Range("D12").Value = "Envoi du mail 0 / 0"
Sheets("Intro").Range("D13").Value = "messages envoyés : 0"
'pour toute les valeurs de k :
For i = 2 To k + 1
'affichage
Sheets("Intro").Range("D12").Value = "Envoi du mail " & i - 1 & " / " & k
'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")
'on crée une instance (la voiture) à partir du modèle : en informatique la 'class' d'un mail (le shema de la voiture)
Set NOUVEAU_MESSAGE = ol.CreateItem(olMailItem)
titre_mail = Sheets("Liste_des_messages").Cells(i, 4)
courriel_to = Sheets("Liste_des_messages").Cells(i, 2)
courriel_cc = Sheets("Liste_des_messages").Cells(i, 3)
corps_mail = Cells(i, 5) & Chr(10)
corps_mail = corps_mail & "Bonjour," & Chr(10) & Chr(10)
corps_mail = corps_mail & "Veuillez trouver ci-joint le fichier du Mois, indiqué en colonne E." & Chr(10) & Chr(10) & Chr(10)
corps_mail = corps_mail & "Cordialement," & Chr(10) & Chr(10)
corps_mail = corps_mail & "Bernard, Tel:06-01-02-03-04-05, NASA." & Chr(10) & Chr(10) & Chr(10)
corps_mail = corps_mail & "Piece(s) jointe(s) :" & Chr(10) & Chr(10)
NOUVEAU_MESSAGE.To = courriel_to
NOUVEAU_MESSAGE.Subject = titre_mail
NOUVEAU_MESSAGE.cc = courriel_cc
NOUVEAU_MESSAGE.Body = corps_mail
j = 6
'rappel : nous sommes dans une boucle qui s'execute pour chaque ligne
'dans la ligne, on verifie que Fichier existe
For j = 6 To 20
If Sheets("Liste_des_messages").Cells(i, j) = "" Then
Exit For
End If
On Error Resume Next
'Ne pas oublier les 2 \\ en debut et a la fin \ sur PC domicile pas de \\
NOUVEAU_MESSAGE.Attachments.Add "E:\Mes documents\TEST\Fichiers\" & Sheets("Liste_des_messages").Cells(i, j) & ".xls"
On Error GoTo 0
Next j
'si Fichiers existe :
If j <> 6 Then
'on incrémente (ajouter 1) le compteur d'envoi
envoi = envoi + 1
Sheets("Intro").Range("D13").Value = "messages envoyés : " & envoi
'on affiche le message
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
End If
Next i
End Sub |
Partager