Envoyer mail via Outlook suivant la valeur d'une cellule
Bonjour,
Je cherche à faire une macro qui envoie un mail lorsque deux cellules de deux colonnes différentes ont une valeur spécifique.
Je m'explique :
J'ai une colonne où les cellules sont soit vraies soit fausses et une autre colonne où l'on écrit "oui" ou alors elle est vide.
Je veux que le mail soit envoyé seulement lorsque la première colonne contient une cellule en mode "Faux" et quand la cellule de l'autre colonne est vide.
Voici mon code actuellement :
Private Sub Worksheet_Change(ByVal Target As Range)
Call notify
End Sub
Sub notify()
Dim rng As Range
For Each rng In Range("H2:H5")
If (rng.Value = False) And IsEmpty(Range("F2:F5")) = True Then
Call SendEmail(rng.Address)
End If
Next rng
End Sub
Private Sub SendEmail(theValue As String)
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hi there" & vbNewLine & vbNewLine & _
"The value that changed is in cell: " & theValue
On Error Resume Next
With xOutMail
.To = "test@gmail.com"
.CC = ""
.BCC = ""
.Subject = "test succeeded"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Je pense que je ne suis pas loin du résultat escompté mais étant un débutant en VBA je ne sais pas trop comment faire par rapport à mes conditions.
Merci pour vos réponses
Bonjour Seiju et bienvenue,
à tester,
If (rng.Value = False) And IsEmpty(cells(rng.Row, "F")) Then
Merci ! Effectivement ça marche.
Maintenant tu saurais comment faire pour que ça m'envoie qu'un seul mail pour toutes les cellules et pas un par cellule qui rentre dans ces conditions ?
En pouvant mettre dans le message du mail toutes les cellules concernées.
J'ai update un peu mon code :
Private Sub Worksheet_Change(ByVal Target As Range)
Call SendEmail
End Sub
Sub SendEmail()
Dim rng As Range
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
For Each rng In Union(Range("H2:H13"), Range("H15:H34"), Range("H36:H45"), Range("H47:H71"), Range("H73:H108"))
If (rng.Value = False) And IsEmpty(Cells(rng.Row, "F")) Then
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Il faut recommander : " & Cells(rng.Row, "B").Value
On Error Resume Next
With xOutMail
.To = "test@gmail.com"
.CC = ""
.BCC = ""
.Subject = "Recommander"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
End If
Next rng
Set xOutApp = Nothing
End Sub
Maintenant il me retourne le texte écrit dans les cases de la colonne B qui correspondent à celles en H et F mais il m'envoie toujours un mail par cellule.
Edit : J'ai rajouté un Union car j'ai des lignes qui séparent les différentes catégories et donc étaient comptées comme des cellules fausses et vides par mon If.
Merci ! Effectivement ça marche.
Maintenant tu saurais comment faire pour que ça m'envoie qu'un seul mail pour toutes les cellules et pas un par cellule qui rentre dans ces conditions ?
En pouvant mettre dans le message du mail toutes les cellules concernées.
peux-tu joindre ton fichier ?
Ci-joint le fichier Excel sur lequel je travaille (uniquement la première feuille)
J'ai trouvé quelques pistes notamment ça :
http://www.rondebruin.nl/win/s1/outlook/bmail2.htm
Avec la fonction RangeToHTML
re,
à tester,
Sub SendEmail()
Dim rng As Range
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim StrBody As String
Set xOutApp = CreateObject("Outlook.Application")
For Each rng In Union(Range("H2:H13"), Range("H15:H34"), Range("H36:H45"), Range("H47:H71"), Range("H73:H108"))
If (rng.Value = False) And IsEmpty(Cells(rng.Row, "F")) Then
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = xMailBody & "Il faut recommander : " & Cells(rng.Row, "B").Value & _
vbNewLine
End If
Next rng
On Error Resume Next
With xOutMail
.To = "test@gmail.com"
.CC = ""
.BCC = ""
.subject = "Stock seuil critique"
.body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Merci !
J'ai une dernière question, tu as dû voir au tout début de ma macro qu'elle se déclenchait que si je changeais la valeur d'une cellule de la colonne C, comment est-ce que je fais pour dire que la macro se déclenche uniquement quand je change une valeur de la colonne C + que cette valeur doit être inférieure à celle de la colonne D ?
Merci !
J'ai une dernière question, tu as dû voir au tout début de ma macro qu'elle se déclenchait que si je changeais la valeur d'une cellule de la colonne C, comment est-ce que je fais pour dire que la macro se déclenche uniquement quand je change une valeur de la colonne C + que cette valeur doit être inférieure à celle de la colonne D ?
re,
fait un essai en remplacant la ligne
If (rng.Value = False) And IsEmpty(Cells(rng.Row, "F")) Then
par
If rng.Value = False And IsEmpty(Cells(rng.Row, "F")) And rng.Value < Cells(rng.Row, "D")Then
Merci !
J'ai une dernière question, tu as dû voir au tout début de ma macro qu'elle se déclenchait que si je changeais la valeur d'une cellule de la colonne C, comment est-ce que je fais pour dire que la macro se déclenche uniquement quand je change une valeur de la colonne C + que cette valeur doit être inférieure à celle de la colonne D ?
désolé, j'avais mal compris la question,
à tester,
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C2:C108")) Is Nothing And Target.Value < Cells(Target.Row, "D") Then
Call SendEmail
End If
End Sub
Merci beaucoup ça fonctionne.
J'ai également rajouté une condition comme quoi la cellule correspondante en F doit être vide pour éviter que la macro se déclenche alors que c'est marqué comme Commandé.