2017-10-14 3 views
0

列Mの数式値(= IF(VAL.EMPTY(K15); "残念ながら、列Kの日付が手動で変更された場合、列Mの数式値のセルで条件が満たされると(> 200)、Sheet1コードによって電子メールコードがトリガーされます(MAX25私の目標は: 1)なぜシート1のこのコードが自動的にメールを送信しないのかを理解する(唯一のことは、列Nに送信されることですこれは私がこのコードが動作すると思うように) 2)私のshのセルで何も手作業で何も変更せずに電子メールを自動的に送信する方法を見つけるeet1。数式の値が条件を満たす場合、Excel内から自動メールを送信

  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 = "[email protected]" 
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 
+0

、それが進むにつれて 'ERROR'ライン上を取り除く....実行をトレース。それはエラーをマスクします – jsotola

+0

私はそれをやったそれはまだOK okでも – Tom

+0

それはしかし、それはまだ送信されていません電子メールとの任意の違いを確認しません – Tom

答えて

0

このようにすることができます。あなたのコードにブレークポイントを入れ

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 = "[email protected]" 
     .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

関連する問題