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
| Sub Mail ()
Dim cel As Range
Dim mMessage As Object
Dim mConfig As Object
Dim mChps
Dim FilePath$
Dim Formulaire$
Dim nWb As Workbook
Dim WshShell, utilisateur
For Each cel In Sheets("mail").Range("B5:Z5")
If cel.Value = "X" Then
a = Sheets("mail").cells(cel.Row - 4, cel.Column)
b = Sheets("mail").cells(cel.Row - 3, cel.Column)
c = Sheets("mail").cells(cel.Row - 2, cel.Column)
d = Sheets("mail").cells(cel.Row - 1, cel.Column)
Set mConfig = CreateObject("CDO.Configuration")
mConfig.Load -1
Set mChps = mConfig.Fields
With mChps
.Item("http://schemas.microsoft.com/ cdo/configuration/urlproxyserver") = "proxy.server:80"
.Item("http://schemas.microsoft.com/ cdo/configuration/urlproxybypass") = "<local>"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "dede@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "dede"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"
.Update
End With
Application.ScreenUpdating = False
Set mMessage = CreateObject("CDO.Message")
With mMessage
Set .Configuration = mConfig
.To = b & ";" & c & ";" & d & ";"
.BCC = ""
.FROM = "adresse@domaine.fr"
.Subject = "Alerte " & a
.TextBody = "Bonjour," & vbCrLf _
& vbCrLf _
& "Le stock" & " " & a & "" & " est" & " " & (Date + 1) & " & vbCrLf" _
& vbCrLf _
& "Cordialement" & vbCrLf _
& vbCrLf & vbCrLf _
& "Service Med , merci de ne pas répondre à ce mail il est généré automatiquement."
.Send
End With
'nWb.Close False
Set mMessage = Nothing
'Libère les ressources
Set mConfig = Nothing
Set mChps = Nothing
End If
Next
End Sub |
Partager