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
| Sub Envoi_email()
'
' Macro pour envoyer un email à chaque adresse
'
'On Error Resume Next
Dim corps As String, assu As String, corps2 As String
Dim tel As String
Dim rgNom As Range, rgPrénom As Range, rgEmail As Range
Dim i As Long
For i = 2 To 6 'pour l'instant envoi uniquement à l'email 2 et 3
If Cells(i, "J").Value <> "" Then 'teste si le n° de téléphone a été renseigné
tel = Cells(i, "J").Value
Else
tel = "non renseigné"
End If
If Cells(i, "F").Value = "RAPP + FIS" Then 'RAPP + FIS ne voulant rien dire aux autres
assu = "Rappatriement + Interruption de séjour" 'je le change quand il apparait
Else
assu = Cells(i, "F").Value
End If
'ici, la définition du corps du message avec les variables
corps = "Nom: " & Cells(i, "B").Value & vbNewLine & _
"Prénom: " & Cells(i, "C").Value & vbNewLine & _
"N° de téléphone: " & tel & vbNewLine & _
"Location de matériel: " & Cells(i, "D").Value & vbNewLine & _
"Food Pack (classique ou sans porc): " & Cells(i, "E").Value & vbNewLine & _
"Assurance: " & assu & vbNewLine & _
"Assurance annulation: " & Cells(i, "G").Value
'ici la définition du corps final avec bonjour, la suite, puis message de fin
corps2 = "Bonjour " & Cells(i, "C").Value & vbNewLine & _
"voici le récapitulatif de votre inscription pour le ski." & vbNewLine & vbNewLine & _
corps & vbNewLine & vbNewLine & _
"Veuillez répondre à cet email en indiquant les erreurs, ou alors que tout est correct" & vbNewLine & vbNewLine & _
"Sandrine Riou"
'commande pour envoyer l'email avec outlook express
Shell "C:\Program Files\Outlook Express\msimn.exe " & "/mailurl:mailto:" _
& Cells(i, "I").Value & "?subject=" & "Test d'envoi automatique de mail" & _
"&Body=" & corps2
Temporisation
Next i
End Sub |
Partager