Envoyer un e-mail automatique depuis Excel si une valeur de formule remplissait une condition

Question

Pourriez-vous s'il vous plaît m'aider à envoyer automatiquement un e-mail à Excel uniquement lorsque la formule dans la colonne M (= IF (VAL.EMPTY (K15); "" ; MAX (K15-Today(); 0)) > 200 Malheureusement le code Sheet1 déclenche le code email si la condition est remplie (> 200) dans la cellule de la valeur de la formule dans la colonne M si la date dans la colonne K est modifiée manuellement ou en écrivant manuellement Non envoyé dans la colonne N. Au lieu de cela mon objectif serait: 1) pour comprendre pourquoi ce code dans sheet1 n'envoie pas l'email automatiquement comme supposé faire (la seule chose qu'il fait est de mettre Sent dans la colonne N 2) pour trouver le moyen d'envoyer l'email automatiquement sans rien changer manuellement dans les cellules de mon sh. eet1.

  H   I  J    K   L   M   N 
     Date  Score Description  Next Due  Status Days till 
                   expiration  
15 28/09/2017 13 Medium Risk  25/07/2018  Valid  284   Sent 
16 11/10/2017 13 Medium Risk  10/08/2018  Valid  300   Sent 

'Sheet1 (FormulaValueChange) 

Private Sub Worksheet_Calculate() 
Dim FormulaRange As Range 
Dim NotSentMsg As String 
Dim MyMsg As String 
Dim SentMsg As String 
Dim MyLimit As Double 

NotSentMsg = "Not Sent" 
SentMsg = "Sent" 

'Above the MyLimit value it will run the macro 
MyLimit = 200 

'Set the range with the Formula that you want to check 
Set FormulaRange = Me.Range("M15:M16") 

On Error GoTo EndMacro: 
For Each FormulaCell In FormulaRange.Cells 
    With FormulaCell 
     If IsNumeric(.Value) = False Then 
      MyMsg = "Not numeric" 
     Else 
      If .Value > MyLimit Then 
       MyMsg = SentMsg 
       If .Offset(0, 1).Value = NotSentMsg Then 
        Call Mail_with_outlook1(FormulaCell) 
       End If 
      Else 
       MyMsg = NotSentMsg 
      End If 
     End If 
     Application.EnableEvents = False 
     .Offset(0, 1).Value = MyMsg 
     Application.EnableEvents = True 
    End With 
Next FormulaCell 

ExitMacro: 
Exit Sub 

EndMacro: 
Application.EnableEvents = True 

MsgBox "Some Error occurred." _ 
    & vbLf & Err.Number _ 
    & vbLf & Err.Description 

End Sub 

'Mail Code 

Option Explicit 

Public FormulaCell As Range 

Sub Mail_with_outlook1(FormulaCell As Range) 

Dim OutApp As Object 
Dim OutMail As Object 
Dim strto As String, strcc As String, strbcc As String 
Dim strsub As String, strbody As String 

Set OutApp = CreateObject("Outlook.Application") 
Set OutMail = OutApp.CreateItem(0) 

strto = "tom@something.abc" 
strcc = "" 
strbcc = "" 
strsub = "Assessement reminders" 
strbody = "Thanks a lot" 
With OutMail 
    .To = strto 
    .CC = strcc 
    .BCC = strbcc 
    .Subject = strsub 
    .Body = strbody 
    'You can add a file to the mail like this 
    '.Attachments.Add ("C:\test.txt") 
    .Display ' or use .Send 
End With 

Set OutMail = Nothing 
Set OutApp = Nothing 
End Sub 

Answer 1

Vous pouvez le faire de cette façon.

Sub Mail_small_Text_Outlook() 
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm 
'Working in Excel 2000-2016 
    Dim OutApp As Object 
    Dim OutMail As Object 
    Dim strbody As String 

    Set OutApp = CreateObject("Outlook.Application") 
    Set OutMail = OutApp.CreateItem(0) 

    strbody = "Hi there" & vbNewLine & vbNewLine & _ 
       "Cell A1 is changed" & vbNewLine & _ 
       "This is line 2" & vbNewLine & _ 
       "This is line 3" & vbNewLine & _ 
       "This is line 4" 

    On Error Resume Next 
    With OutMail 
     .To = "ron@debruin.nl" 
     .CC = "" 
     .BCC = "" 
     .Subject = "This is the Subject line" 
     .Body = strbody 
     'You can add a file like this 
     '.Attachments.Add ("C:\test.txt") 
     .Display 'or use .Send 
    End With 
    On Error GoTo 0 

    Set OutMail = Nothing 
    Set OutApp = Nothing 
End Sub 

https://www.rondebruin.nl/win/s1/outlook/bmail9.htm