提示:其它语言是由 Google 机器翻译的。 你可以访问 English 版本。
登录
x
or
x
x
马上登记
x

or

如何根据Excel中的单元格值自动发送电子邮件?

假设您想通过Outlook将电子邮件发送给基于Excel中指定单元格值的特定收件人。 例如,当工作表中单元格D7的值大于200时,将自动创建一封电子邮件。 本文介绍一种VBA方法,以便您快速解决此问题。

使用VBA代码自动发送基于单元值的电子邮件


根据Excel中创建的邮件列表字段,通过Outlook轻松发送电子邮件:

在此 发电子邮件 实用程序 Kutools for Excel 帮助用户根据Excel中创建的邮件列表通过Outlook发送电子邮件。 立即下载Kutools for Excel的全功能60天免费试用版!

  • 创建一个包含所有需要的邮件字段的邮件列表并全选。
  • 启用“发送电子邮件”功能并填写您的电子邮件正文。
  • 通过outlook发送。

Kutools for Excel:比200方便的Excel加载项,可以在60天免费试用。 立即下载免费试用版!

Office选项卡在Office中启用选项卡式编辑和浏览,使您的工作更轻松......
Kutools for Excel解决了您的大多数问题,并使您的生产率提高了80%
  • 重用任何东西: 将最常用或最复杂的公式,图表和其他任何内容添加到您的收藏夹中,并在将来快速重复使用它们。
  • 超过20文本功能: 从文本字符串中提取数字; 提取或删除部分文本; 将数字和货币转换为英语单词...
  • 合并工具:多个工作簿和表格合二为一; 合并多个单元格/行/列而不丢失数据; 合并重复行和总和...
  • 拆分工具:根据价值将数据拆分为多个表格; 一个工作簿到多个Excel,PDF或CSV文件; 一列到多列......
  • 粘贴跳过 隐藏/过滤行; 数和总和 按背景颜色; 创建邮件列表和 通过Cell的价值发送电子邮件...
  • 超级过滤器: 创建高级过滤方案并应用于任何工作表; 排序 按周,日,频率等; 筛选 通过大胆,公式,评论......
  • 超过300强大的功能; 与Office 2007-2019和365一起使用; 支持所有语言; 在您的企业或组织中轻松部署。

使用VBA代码自动发送基于单元值的电子邮件

请按照以下方法在Excel中根据单元格值发送电子邮件。

1。 在工作表中,您需要根据单元格值发送电子邮件(这里是单元格D7),右键单击工作表选项卡,然后选择 查看代码 从上下文菜单。 看截图:

2。 在弹出 Microsoft Visual Basic for Applications 窗口,请将以下VBA代码复制并粘贴到工作表代码窗口中。

VBA代码:基于Excel中的单元格值通过Outlook发送电子邮件

Dim xRg As Range
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("D7"), Target)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value > 200 Then
        Call Mail_small_Text_Outlook
    End If
End Sub
Sub Mail_small_Text_Outlook()
    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 & _
              "This is line 1" & vbNewLine & _
              "This is line 2"
    On Error Resume Next
    With xOutMail
        .To = "Email Address"
        .CC = ""
        .BCC = ""
        .Subject = "send by cell value test"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

笔记:

1。 在VBA代码中, D7 值> 200 是您将基于其发送电子邮件的单元格和单元格值。

2。 请根据需要更改电子邮件正文 xMailBody 在代码中的行。

3。 将电子邮件地址替换为收件人电子邮件地址 .To =“电子邮件地址”.

4。 根据需要指定抄送和密件抄送收件人 .CC =“” Bcc =“” 部分。

5。 最后更改电子邮件主题 .Subject =“通过单元格值测试发送”.

3。 按 其他 + Q 钥匙一起关闭 Microsoft Visual Basic for Applications 窗口。

从现在起,当您在单元格D7中输入的值大于200时,将在Outlook中自动创建一封包含指定收件人和正文的电子邮件。 你可以点击 发送 按钮发送此电子邮件。 看截图:

笔记:

1。 当您使用Outlook作为您的电子邮件程序时,VBA代码才起作用。

2。 如果在单元格D7中输入的数据是文本值,则电子邮件窗口也会弹出。


Office Tab - 在Excel中选项卡式浏览,编辑和管理工作簿:

Office选项卡将Web浏览器(如Google Chrome,Internet Explorer新版本和Firefox)中显示的选项卡界面带到Microsoft Excel。 它将是一个节省时间的工具,在您的工作中无可比拟。 见下面的演示:

点击免费试用Office Tab!

Excel的Office选项卡


相关文章:


Kutools for Excel解决了您的大多数问题,并使您的生产率提高了80%

  • 重用: 快速插入 复杂的公式,图表 以及你以前用过的任何东西; 加密单元格 密码; 创建邮件列表 并发送电子邮件...
  • 超级方程式酒吧 (轻松编辑多行文字和公式); 阅读布局 (轻松读取和编辑大量单元格); 粘贴到过滤范围...
  • 合并单元格/行/列 不丢失数据; 分裂细胞含量; 组合重复的行/列...防止重复的细胞; 比较范围...
  • 选择复制或唯一 行; 选择空行 (所有细胞都是空的); 超级查找和模糊查找 在许多工作簿中; 随机选择......
  • 精确复制 多个单元格而不更改公式参考; 自动创建参考 多张表; 插入项目符号,复选框等等......
  • 提取文本,添加文本,按位置删除, 删除空间; 创建和打印分页小计; 在单元格内容和注释之间转换...
  • 超级过滤器 (将过滤方案保存并应用到其他工作表); 高级排序 按月/周/日,频率等; 特殊过滤器 用粗体,斜体......
  • 结合工作簿和工作表; 根据键列合并表; 将数据拆分为多个表格; 批量转换xls,xlsx和PDF...
  • 超过300强大的功能。 支持Office / Excel 2007-2019和365。 支持所有语言。 在您的企业或组织中轻松部署。 全功能30天免费试用。
kte tab 201905

Office选项卡为Office提供选项卡式界面,使您的工作更轻松

  • 在Word,Excel,PowerPoint中启用选项卡式编辑和阅读,Publisher,Access,Visio和Project。
  • 在同一窗口的新选项卡中打开并创建多个文档,而不是在新窗口中。
  • 通过50%提高您的工作效率,每天为您减少数百次鼠标点击!
官方底部
Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Vignesh · 1 years ago
    I am trying to mail the content which is present in A1:G5 columns in excel ,but its not working. Can you help me with that?
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi Vignesh,
      The following VBA code can help you solve the problem. Thank you for your comment.

      Dim xRg As Range
      Private Sub Worksheet_Change(ByVal Target As Range)
      On Error Resume Next
      If Target.Cells.Count > 1 Then Exit Sub
      Set xRg = Intersect(Range("D7"), Target)
      If xRg Is Nothing Then Exit Sub
      If IsNumeric(Target.Value) And Target.Value > 200 Then
      Call Mail_small_Text_Outlook
      End If
      End Sub
      Sub Mail_small_Text_Outlook()
      Dim I, J As Long
      Dim xRg As Range
      Dim xStr As String
      Dim xOutApp As Object
      Dim xOutMail As Object
      Dim xMailBody As String
      Set xOutApp = CreateObject("Outlook.Application")
      Set xOutMail = xOutApp.CreateItem(0)
      Set xRg = Range("A1:G5")
      For I = 1 To xRg.Rows.Count
      For J = 1 To xRg.Columns.Count
      xStr = xStr & xRg.Rows(I).Cells(J) & " "
      Next
      xStr = xStr & vbNewLine
      Next
      xMailBody = "Hi there" & vbNewLine & vbNewLine & xStr
      On Error Resume Next
      With xOutMail
      .To = "Email Address"
      .CC = ""
      .BCC = ""
      .Subject = "send by cell value test"
      .Body = xMailBody
      .Display 'or use .Send
      End With
      On Error GoTo 0
      Set xOutMail = Nothing
      Set xOutApp = Nothing
      End Sub
  • To post as a guest, your comment is unpublished.
    Pavel · 1 years ago
    I would like to ask if it is possible to send one email when closing the application - each change means a large number of emails.


    Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If (Not Intersect(Target, Range("B2:B9")) Is Nothing) And (Target.Value < 3) Then
    Call Mail_small_Text_Outlook
    End If
    End Sub
    Sub Mail_small_Text_Outlook()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Ahoj," & vbNewLine & vbNewLine & _
    "xxx." & vbNewLine & _
    ""
    On Error Resume Next
    With xOutMail
    .To = "xxx"
    .CC = ""
    .BCC = ""
    .Subject = "xxx"
    .Body = xMailBody
    .Send 'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
    End Sub


    Thank you
  • To post as a guest, your comment is unpublished.
    Pavel · 1 years ago
    Hello
    I would like to ask if it is possible to send one email when closing the application - each change means a large number of emails.

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If (Not Intersect(Target, Range("B2:B9")) Is Nothing) And (Target.Value < 3) Then
    Call Mail_small_Text_Outlook
    End If
    End Sub
    Sub Mail_small_Text_Outlook()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Ahoj," & vbNewLine & vbNewLine & _
    "XXX." & vbNewLine & _
    ""
    On Error Resume Next
    With xOutMail
    .To = "1234"
    .CC = ""
    .BCC = ""
    .Subject = "XXX"
    .Body = xMailBody
    .Send 'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
    End Sub
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hello Pavel,
      Would you explain it in more details? I don't really get your point, sorry about that.
  • To post as a guest, your comment is unpublished.
    fifi · 1 years ago
    hello, can u help me
    1. send this email with attach the worksheet
    2. set timer automatically send this email weekly (like every sunday)


    thanks
  • To post as a guest, your comment is unpublished.
    jason · 1 years ago
    hello, sir: may i ask how to display the value in D7 in the out bouncing email automatically ?
    thanks
    jason
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Dear Jason,
      The following VBA code can help you solve the problem. Thank you.

      Dim xRg As Range
      'Update by Extendoffice 2018/5/22
      Private Sub Worksheet_Change(ByVal Target As Range)
      On Error Resume Next
      If Target.Cells.Count > 1 Then Exit Sub
      Set xRg = Intersect(Range("D7"), Target)
      If xRg Is Nothing Then Exit Sub
      If IsNumeric(Target.Value) And Target.Value > 200 Then
      Call Mail_small_Text_Outlook
      End If
      End Sub
      Sub Mail_small_Text_Outlook()
      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 & _
      "This is line 1" & vbNewLine & _
      "This is line 2 " & vbNewLine & "value is " & xRg.Value
      On Error Resume Next
      With xOutMail
      .To = "Email Address"
      .CC = ""
      .BCC = ""
      .Subject = "send by cell value test"
      .Body = xMailBody
      .Display 'or use .Send
      End With
      On Error GoTo 0
      Set xOutMail = Nothing
      Set xOutApp = Nothing
      End Sub
  • To post as a guest, your comment is unpublished.
    kevin b · 1 years ago
    Hello- If I wanted to send to an email from a list instead of putting actual email addy in the code, is that possible? thanks
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hello,
      Please try below VBA code, when the specified cell meets the condition, a dialog will pop up, please select the cell contains the email address you will sent email to. Hope it can help. Thank you.

      Private Sub Worksheet_Change(ByVal Target As Range)
      If Target.Cells.Count > 1 Then Exit Sub
      Set xRg = Range("D7")
      If xRg = Target And Target.Value > 200 Then
      Call Mail_small_Text_Outlook
      End If
      End Sub
      Sub Mail_small_Text_Outlook()
      Dim xOutApp As Object
      Dim xOutMail As Object
      Dim xMailBody As String
      Dim xRgMsg As Range
      Dim xCell As Range
      Set xRgMsg = Application.InputBox("Please select the address cells:", "Kutools for Excel", , , , , , 8)
      xMailBody = "Hi there" & vbNewLine & vbNewLine & _
      "This is line 1" & vbNewLine & _
      "This is line 2"
      On Error Resume Next
      For Each xCell In xRgMsg
      Set xOutApp = CreateObject("Outlook.Application")
      Set xOutMail = xOutApp.CreateItem(0)
      With xOutMail
      .To = xCell.Value
      .CC = ""
      .BCC = ""
      .Subject = "send by cell value test"
      .Body = xMailBody
      .Display 'or use .Send
      End With
      xOutApp = Nothing
      xOutMail = Nothing
      Next
      On Error GoTo 0
      End Sub
  • To post as a guest, your comment is unpublished.
    basha · 1 years ago
    hi crystal
    thanks for your codes, if possible kindly send the codes for below given details

    if we have 8 to 9 coloums using different type of expires like passport expiry date, driving licence expiry date, vehicle registration expiry date, gate pass expiry date and more etc., and mail alert must send to only 5 given persons.

    like our date sheet is with more than 300 employees, expired and expiry date with in 15 days in red colour and email alert should sent.

    kindly do the needful

    thanks in advance
  • To post as a guest, your comment is unpublished.
    Noemi · 1 years ago
    So I used your edit to include a cell ranges but (if we are using the worksheet example) I was wondering how to add the type of fruit, the Date, and the quantity into the HTML email from the worksheet if they fit the criteria to have an email generated. So it would say

    "Hi there,"

    Fruit name from cell "Needs to be put on back order because as of order date: " order date from cell "we have this amount:" quantity from cell.
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi Noemi,
      Please try this VBA scrip.

      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim xRg As Range
      Dim I, J, K As Long
      Dim xOutApp As Object
      Dim xOutMail As Object
      Dim xMailBody As String
      On Error Resume Next
      If Target.Address = Range("D7").Address Then
      With Application.WorksheetFunction
      If IsNumeric(Target.Value) And Target.Value > 200 Then
      Set xRg = Application.InputBox("Please select the cell range you will display in the mail body:", "KuTools for Excel", Selection.Address, , , , , 8)
      If xRg Is Nothing Then Exit Sub
      For I = 1 To xRg.Rows.Count
      For J = 1 To xRg.Rows(I).Columns.Count
      For K = 1 To xRg.Rows(I).Columns(J).Count
      xMailBody = xMailBody & " " & xRg.Rows(I).Columns(J).Cells(K).Text
      Next
      Next
      xMailBody = xMailBody & vbNewLine
      Next
      Set xOutApp = CreateObject("Outlook.Application")
      Set xOutMail = xOutApp.CreateItem(0)
      With xOutMail
      .To = "Email Address"
      .CC = ""
      .BCC = ""
      .Subject = "send by cell value test"
      .Body = "Hi there " & vbNewLine & xMailBody
      .Display 'or use .Send
      End With
      On Error GoTo 0
      Set xOutMail = Nothing
      Set xOutApp = Nothing
      End If
      End With
      End If
      End Sub
  • To post as a guest, your comment is unpublished.
    Jan · 1 years ago
    Hi,
    I would like Outlook to pop out only when the data I have pasted into the Range ("D7:F7") has at least 1 zero or a blank.
    I have removed the 'If Target.Cells.Count > 1 Then Exit Sub' line and now Outlook always launches when i paste any group of values into cells D7:F7.

    Help.
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Dear Jan,
      The following script can help you solve the problem. Thank you for your comment.

      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim xOutApp As Object
      Dim xOutMail As Object
      Dim xMailBody As String
      On Error Resume Next
      If Target.Address = Range("D7:F7").Address Then
      With Application.WorksheetFunction
      If .CountIf(Target, "") > 0 Or .CountIf(Target, 0) > 0 Then
      Set xOutApp = CreateObject("Outlook.Application")
      Set xOutMail = xOutApp.CreateItem(0)
      With xOutMail
      .To = "Email Address"
      .CC = ""
      .BCC = ""
      .Subject = "send by cell value test"
      .Body = "Hi there "
      .Display 'or use .Send
      End With
      On Error GoTo 0
      Set xOutMail = Nothing
      Set xOutApp = Nothing
      End If
      End With
      End If
      End Sub
  • To post as a guest, your comment is unpublished.
    Jesse · 1 years ago
    Hi,


    What if I wanted to send the email based off of the word "completed" being added to column L?
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Dear Jesse,
      The following VBA code can help you solve the problem. Thank you for your comment.

      Private Sub Worksheet_Change(ByVal Target As Range)
      If Target.Cells.Count > 1 Then Exit Sub
      If (Not Intersect(Target, Range("L:L")) Is Nothing) And (Target.Value = "completed") Then
      Call Mail_small_Text_Outlook
      End If
      End Sub
      Sub Mail_small_Text_Outlook()
      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 & _
      "This is line 1" & vbNewLine & _
      "This is line 2"
      On Error Resume Next
      With xOutMail
      .To = "Your recipient's email address"
      .CC = ""
      .BCC = ""
      .Subject = "send by cell value test"
      .Body = xMailBody
      .Display 'or use .Send
      End With
      On Error GoTo 0
      Set xOutMail = Nothing
      Set xOutApp = Nothing
      End Sub
  • To post as a guest, your comment is unpublished.
    martyn · 1 years ago
    Hi there,


    I currently having a little trouble this the coding (new to this - may have bitten off more than I can chew)


    I currently have a spreadsheet with the following that I need help to automate and send email for fault that are at our properties for our business


    I currently need a code that will do use the following data:


    1) An address and the issue ( 2 "general" cells that have been merged via ((In cell D1)) " = =CONCAT(B1," "C1,) "
    The address in B1 will allways be same (more or less)
    Whilst C1 will always be changing dependant on the fault at the property.


    2) An email to be sent by the same email adress, ( can I use $E$1 or I have to use E1 - E1 . for example) or can I just Input " TheEmailAdress@.co.uk" in the line of code


    3) The email body to be populated in the similar way to point 1) ...... ((In cell F1)) " =CONCAT(G1," ",H1)
    These will be changing constantly as they represent the company (G1) and what they are doing , fixing, quoting ect (H1)

    4) The trigger to send the email off, I would be the number 7 , the sheet gets updated daily (7 days in a week)
    as such I need the trigger to send the email on day 7, but no constantly like on day 8, 9 , 10+ ect. and not before such as 1-6, this would be in A4 : A 100+ (as we are constantly expanding


    4) I've used small snippets from other users who mentioned about using a list for the trigger to send the email, but not sure was 100 % it was correct, but i'd need it to scan though all Collum A.... A4: A100
    and if there are 47 cells that contain only " 7 " then 47 Emails will be sent


    Thank you ever so much for reading and I hope you can help :)
  • To post as a guest, your comment is unpublished.
    Ann · 1 years ago
    Hi

    Thank you so much for posting this VBA Code and instructions. When I found it I felt like I had won the lotto. However I am stuck on something so I'm hoping you can help (I'm new to VBA, only have very basic understanding).

    I've copied the code and changed the cell and cell value to pick from a range if a criteria is met. I have tried and tested and it works and I received an email to outlook based on the criteria.

    1) However, I cannot seem to figure out how to get the VBA code to run automatically when I open up the excel worksheet, rather than having to click on the VBA application and select run. Could you advise if there is an additional prompt to type into the VBA code above that will do this or does it have to be done separately.

    2) Also is there a way to get the VBA code to send a mail to a person if the due date is yes for a certain item as shown in example below.
    email hidden column
    Name

    Procedure
    Procedure no.1 due date yes
    Procedure no. 2 due date no

    I would have numerous people in the spreadsheet (going across horizontally in a row) and 'Yes' could be highlighted for various overdue procedures (listed vertically in column A. Is there a way to create a VBA code that runs for something like this - if 'Yes' for 'Person 1', then email 'person 1' with 'procedure no #' (or numbers) and due date(s). Being able to list in the email all the procedures and their subsequent due dates.

    I wouldn't mind if I had to set a separate VBA code for each person as long as it sent a mail of all the documents overdue for that person and the due dates.

    Hoping you can help
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Dear Ann,
      Please try the below VBA code. Thank you for your comment.

      Sub Mail_small_Text_Outlook()
      Dim xRg As Range
      Dim xCell As Range
      Dim I As Long
      Dim xRows As Long
      Dim xCols As Long
      Dim xVal As String
      Dim xOutApp As Object
      Dim xOutMail As Object
      Dim xMailBody As String
      On Error Resume Next
      Set xRg = Application.InputBox("Select the range contains the cell value you will send emails based on:", "Kutools for Excel", Selection.Address, , , , , 8)
      If xRg Is Nothing Then Exit Sub
      xRows = xRg.Rows.Count
      xCols = xRg.Columns.Count
      For I = 1 To xRows
      Set xCell = xRg(I, xCols)
      If xCell.Value = "Yes" Then
      Set xOutApp = CreateObject("Outlook.Application")
      Set xOutMail = xOutApp.CreateItem(0)
      xMailBody = "Hi there" & vbNewLine & vbNewLine & _
      "This is your information: " & vbNewLine & xCell.Offset(0, -1).Text & vbNewLine & xCell.Offset(0, -2).Text
      With xOutMail
      .To = xCell.Offset(0, -4).Text
      .Subject = "send by cell value test"
      .Body = xMailBody
      .Display 'or use .Send
      End With
      On Error GoTo 0
      Set xOutMail = Nothing
      Set xOutApp = Nothing
      End If
      Next
      End Sub
      • To post as a guest, your comment is unpublished.
        Jacob · 1 years ago
        Where exactly do we insert this code?
        • To post as a guest, your comment is unpublished.
          crystal · 1 years ago
          Good day,
          You need to place the code into the worksheet's code window.
          Open the Microsoft Visual Basic for Applications window, double click the sheet name in the left pane to open the code editor.
      • To post as a guest, your comment is unpublished.
        Jermaine · 1 years ago
        Crystal,

        This replaces the following code:

        Sub email()

        Dim xRg As Range

        Dim xRgEach As Range

        Dim xEmail_Subject, xEmail_Send_Form,;etc.
  • To post as a guest, your comment is unpublished.
    Hanizah Ismail · 1 years ago
    how to stop code from running ie don't prompt the email when condition is not met?

    even when D7 < 200, I still get prompted the email.
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Good Day,
      The code is updated in the post with the problem solved. Thank you for your comment.
  • To post as a guest, your comment is unpublished.
    Savio Jois · 1 years ago
    How can you add Multiple Range to "Set xRg = Range("D7")". I want to edit it and add Range("D7:F7"). However i am getting an error of Run Time Error 13, Type Mismatch and it is taking me to If xRg = Target And Target.Value > 2 Then.


    How can i solve this proble?
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Good Day,
      Please try below VBA code to solve the problem.

      Private Sub Worksheet_Change(ByVal Target As Range)
      If Target.Cells.Count > 1 Then Exit Sub
      If (Not Intersect(Target, Range("D7:F7")) Is Nothing) And (Target.Value > 200) Then
      Call Mail_small_Text_Outlook
      End If
      End Sub
      Sub Mail_small_Text_Outlook()
      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 & _
      "This is line 1" & vbNewLine & _
      "This is line 2"
      On Error Resume Next
      With xOutMail
      .To = "Your recipient's email address"
      .CC = ""
      .BCC = ""
      .Subject = "send by cell value test"
      .Body = xMailBody
      .Display 'or use .Send
      End With
      On Error GoTo 0
      Set xOutMail = Nothing
      Set xOutApp = Nothing
      End Sub
      • To post as a guest, your comment is unpublished.
        Nitol · 1 years ago
        It is not working for me as the value in D7 is a result of a formual. What if cell D7 contains a formula, e.g. D7 =2*120? It still meets the condition but nothing is happening. Please help
      • To post as a guest, your comment is unpublished.
        Savio Jois · 1 years ago
        worked perfectly fine.. Thank you..:):)
  • To post as a guest, your comment is unpublished.
    Doug · 1 years ago
    How can I edit the code to send an email based on a date in the cell. For example, I need a document reviewed every 15 months and I want to kick out an email at 12 months to an email address saying the document needs to be reviewed. I've got it now to auto-send an email by changing .Display to .Send and it works great as written, but what do I need to change to use a date function instead of a whole number??
  • To post as a guest, your comment is unpublished.
    New2Excel · 1 years ago
    Hello what code would I use if I am trying to send an email to a manager that has a list of the fruit that has a quantity > 200 once per month (based on your example) or expires soon( based on dates)
  • To post as a guest, your comment is unpublished.
    mayank vijay · 1 years ago
    I am having trouble sending mail through outlook. I receive the error saying "A program is trying to send an email on your behalf. If it is unexpected, please deny and verify your anti-virus software is up to date"
    Please help as I am not able to automate it.
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Sorry mayank,
      The code works well in my case. It seems that something about "send on behalf" function is configured in your Outlook. Pease check for it.
  • To post as a guest, your comment is unpublished.
    Dhruv · 1 years ago
    I have a list of email addresses already in an excel file, how can I modify the code to automatically choose the email address of the person if his cell D7 is >200?
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Good Day,
      The following VBA code can help you solve the problem. Please place the VBA script into your worksheet module. When value in the specified cell meet the condition, a Kutools for Excel dialog box will pop up, please select the cells which contain the recipients' email addresses and then click the OK button. Then emails with specified recipients are opening. Please send them as you need.

      Private Sub Worksheet_Change(ByVal Target As Range)
      If Target.Cells.Count > 1 Then Exit Sub
      Set xRg = Range("D7")
      If xRg = Target And Target.Value > 200 Then
      Call Mail_small_Text_Outlook
      End If
      End Sub
      Sub Mail_small_Text_Outlook()
      Dim xOutApp As Object
      Dim xOutMail As Object
      Dim xMailBody As String
      Dim xRgMsg As Range
      Dim xCell As Range
      Set xRgMsg = Application.InputBox("Please select the address cells:", "Kutools for Excel", , , , , , 8)
      xMailBody = "Hi there" & vbNewLine & vbNewLine & _
      "This is line 1" & vbNewLine & _
      "This is line 2"
      On Error Resume Next
      For Each xCell In xRgMsg
      Set xOutApp = CreateObject("Outlook.Application")
      Set xOutMail = xOutApp.CreateItem(0)
      With xOutMail
      .To = xCell.Value
      .CC = ""
      .BCC = ""
      .Subject = "send by cell value test"
      .Body = xMailBody
      .Display 'or use .Send
      End With
      xOutApp = Nothing
      xOutMail = Nothing
      Next
      On Error GoTo 0
      End Sub
  • To post as a guest, your comment is unpublished.
    Frank · 1 years ago
    How could I change this code for sending student grades to parents. Where if column A is the grade and Column B is the parent email. I want to populate an email for each student with an F as a grade.
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Dear Frank,
      The below VBA code can help you solve the problem. Thank you.

      Sub Mail_small_Text_Outlook()
      Dim xRg As Range
      Dim I As Long
      Dim xRows As Long
      Dim xVal As String
      Dim xOutApp As Object
      Dim xOutMail As Object
      Dim xMailBody As String
      On Error Resume Next
      Set xRg = Application.InputBox("Please select grade column and the email column (two columns)", "Kutools for Excel", Selection.Address, , , , , 8)
      If xRg Is Nothing Then Exit Sub
      xRows = xRg.Rows.Count
      Set xRg = xRg(2)
      For I = 1 To xRows
      xVal = xRg.Offset(I, -1).Text
      If xVal = "F" Then
      Set xOutApp = CreateObject("Outlook.Application")
      Set xOutMail = xOutApp.CreateItem(0)
      xMailBody = "Hi there" & vbNewLine & vbNewLine & _
      "This is your child's grade " & xRg.Offset(I, -1).Text
      With xOutMail
      .to = xRg.Offset(I, 0).Text
      .Subject = "send by cell value test"
      .Body = xMailBody
      .Display 'or use .Send
      End With
      On Error GoTo 0
      Set xOutMail = Nothing
      Set xOutApp = Nothing
      End If
      Next
      End Sub
  • To post as a guest, your comment is unpublished.
    Jose Manuel · 1 years ago
    Hello, how would you modify this code to check wether a group of cells have the string "No match" and send an email if it has.
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Dear Jose,
      Please try below VBA code. When running the code, a dialog box pops up, please select the range you will check for string, and click the OK button. if the string does not exist, you will get a prompt dialog box. If the string exists in the range, an email with specified recipient, subject and body will display.

      Sub SendEmail()
      Dim I As Long
      Dim J As Long
      Dim xRg As Range
      Dim xArr
      Dim xOutApp As Object
      Dim xOutMail As Object
      Dim xMailBody As String
      Dim xFlag As Boolean
      On Error Resume Next
      Set xRg = Application.InputBox("Please select range", "Kutools for Excel", Selection.Address, , , , , 8)
      If xRg Is Nothing Then Exit Sub
      xArr = xRg.Value
      xFlag = False
      For I = 1 To UBound(xArr)
      For J = 1 To UBound(xArr, 2)
      If xArr(I, J) = "No Match" Then
      xFlag = True
      End If
      Next
      Next
      If xFlag Then
      Set xOutApp = CreateObject("Outlook.Application")
      Set xOutMail = xOutApp.CreateItem(0)
      xMailBody = "Hi there" & vbNewLine & vbNewLine & _
      "This is line 1" & vbNewLine & _
      "This is line 2"
      With xOutMail
      .To = "Email address"
      .CC = ""
      .BCC = ""
      .Subject = "Match"
      .Body = xMailBody
      .Display 'or use .Send
      End With
      Else
      MsgBox "Found No matched value", vbInformation, "KuTools for Excel"
      End If
      End Sub
  • To post as a guest, your comment is unpublished.
    basil · 1 years ago
    Hi I put the same script but it is not working please help me in the 1st part

    Dim xRg As Range

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Range("D7")
    If xRg = Target And Target.Value = 200 Then
    Call Mail_small_Text_Outlook
    End If

    End Sub
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Dear basil,
      Is there any warning when running the code?
  • To post as a guest, your comment is unpublished.
    Brahma · 1 years ago
    will it be sent automatically mail, without any manual interruption
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Dear Brahma,
      If you want to directly send the email without displaying, please replace the line ".Display" with ".Send" in the above VBA code.
  • To post as a guest, your comment is unpublished.
    Shawn Henry · 1 years ago
    Hello

    I am having trouble because Email recipient has to be added again and again one by one. Please guide if list of email recipients can be added to this function so the the function will select the email address from the list of email addresses provided or list upload and the function sends the email, already composed to the desired recipient.
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Dear Henry,
      The following VBA code can help you solve the problem. Please place the VBA script into your worksheet module. When value in the specified cell meet the condition, a Kutools for Excel dialog box will pop up, please select the cells which contain the recipients' email addresses and then click the OK button. Then emails with specified recipients are opening. Please send them as you need.

      Private Sub Worksheet_Change(ByVal Target As Range)
      If Target.Cells.Count > 1 Then Exit Sub
      Set xRg = Range("D7")
      If xRg = Target And Target.Value > 200 Then
      Call Mail_small_Text_Outlook
      End If
      End Sub
      Sub Mail_small_Text_Outlook()
      Dim xOutApp As Object
      Dim xOutMail As Object
      Dim xMailBody As String
      Dim xRgMsg As Range
      Dim xCell As Range
      Set xRgMsg = Application.InputBox("Please select the address cells:", "Kutools for Excel", , , , , , 8)
      xMailBody = "Hi there" & vbNewLine & vbNewLine & _
      "This is line 1" & vbNewLine & _
      "This is line 2"
      On Error Resume Next
      For Each xCell In xRgMsg
      Set xOutApp = CreateObject("Outlook.Application")
      Set xOutMail = xOutApp.CreateItem(0)
      With xOutMail
      .To = xCell.Value
      .CC = ""
      .BCC = ""
      .Subject = "send by cell value test"
      .Body = xMailBody
      .Display 'or use .Send
      End With
      xOutApp = Nothing
      xOutMail = Nothing
      Next
      On Error GoTo 0
      End Sub
  • To post as a guest, your comment is unpublished.
    Jordan · 1 years ago
    I am having trouble getting this code to prompt if the value in the cell is changed indirectly. For example, if I have Sum equation changing this value automatically. When the equation runs and the value goes above the set value to prompt the email, it does not do so, unless I physically change the number myself. Is there a way to make the email prompt even if changed indirectly?
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Dear Jordan,
      The following VBA code can help you solve the problem. Please don't forget to replace the "Email Address" with the recipient's email address in the code. Thank you.

      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim xRgPre As Range
      On Error Resume Next
      If Target.Cells.Count > 1 Then Exit Sub
      Set xRg = Range("D7")
      Set xRgPre = xRg.Precedents
      If xRg.Value > 200 Then
      If Target.Address = xRg.Address Then
      Call Mail_small_Text_Outlook
      ElseIf (Not xRgPre Is Nothing) And (Intersect(Target, xRgPre).Address = Target.Address) Then
      Call Mail_small_Text_Outlook
      End If
      End If
      End Sub
      Sub Mail_small_Text_Outlook()
      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 & _
      "This is line 1" & vbNewLine & _
      "This is line 2"
      On Error Resume Next
      With xOutMail
      .To = "Email Address"
      .CC = ""
      .BCC = ""
      .Subject = "send by cell value test"
      .Body = xMailBody
      .Display 'or use .Send
      End With
      On Error GoTo 0
      Set xOutMail = Nothing
      Set xOutApp = Nothing
      End Sub
      • To post as a guest, your comment is unpublished.
        Jim · 3 months ago
        I used this code with the only change being I have applied it to an entire column [Set xRg = Range("D4:D13")]. Now the event triggers whenever a calculation is made regardless of whether the valve in Column D is below the target value. Any idea's why that is?


        Dim Xrg As Range
        Private Sub Worksheet_Change(ByVal Target As Range)
        Dim xRgPre As Range
        On Error Resume Next
        If Target.Cells.Count > 1 Then Exit Sub
        Set Xrg = Range("D4:D13")
        Set xRgPre = Xrg.Precedents
        If Xrg.Value < 1200 Then
        If Target.Address = Xrg.Address Then
        Call Mail_small_Text_Outlook
        ElseIf (Not xRgPre Is Nothing) And (Intersect(Target, xRgPre).Address = Target.Address) Then
        Call Mail_small_Text_Outlook
        End If
        End If
        End Sub

        Sub Mail_small_Text_Outlook()
        Dim xOutApp As Object
        Dim xOutMail As Object
        Dim xMailBody As String
        Set xOutApp = CreateObject("Outlook.Application")
        Set xOutMail = xOutApp.CreateItem(0)
        xMailBody = "Hi" & vbNewLine & _
        "Test vba" _
        & vbNewLine & _
        "Line 2."
        On Error Resume Next
        With xOutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Auto Email Test"
        .Body = xMailBody
        .Display
        End With
        On Error GoTo 0
        Set xOutMail = Nothing
        Set xOutApp = Nothing

        End Sub


        Thanks.
      • To post as a guest, your comment is unpublished.
        Daniel · 1 years ago
        I've modified suggested code to try to make it work for my application.
        Changed xRg = Range("C2:C40") and If xRg.Value = -1.

        The issue that I'm having is anytime there is a change to any cell and as long as one of the cells in my range is = -1 it will call Mail_small_Text_Outlook.
        I'm trying to only call if any cell in my range is changed indirectly to -1.
        I was also wondering if and how it would be possible to have it meet two criteria.
        Like check range A and range B and if they meet criteria call function.

        Thanks in advance for the help. I'm new to all this but reading through this thread has me about 90% there.


        Private Sub Worksheet_Change(ByVal Target As Range)
        Dim xRgPre As Range
        On Error Resume Next
        If Target.Cells.Count > 1 Then Exit Sub
        Set xRg = Range("C2:C40")
        Set xRgPre = xRg.Precedents
        If xRg.Value = -1 Then
        If Target.Address = xRg.Address Then
        Call Mail_small_Text_Outlook
        ElseIf (Not xRgPre Is Nothing) And (Intersect(Target, xRgPre).Address = Target.Address) Then
        Call Mail_small_Text_Outlook
        End If
        End If
        End Sub
  • To post as a guest, your comment is unpublished.
    Debbie · 1 years ago
    How should the code be modified, to apply to an entire range of cells?
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Dear Debbie,
      Please try below VBA code to solve the problem.

      Private Sub Worksheet_Change(ByVal Target As Range)
      If Target.Cells.Count > 1 Then Exit Sub
      If (Not Intersect(Target, Range("A1:D4")) Is Nothing) And (Target.Value > 200) Then
      Call Mail_small_Text_Outlook
      End If
      End Sub
      Sub Mail_small_Text_Outlook()
      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 & _
      "This is line 1" & vbNewLine & _
      "This is line 2"
      On Error Resume Next
      With xOutMail
      .To = "Your recipient's email address"
      .CC = ""
      .BCC = ""
      .Subject = "send by cell value test"
      .Body = xMailBody
      .Display 'or use .Send
      End With
      On Error GoTo 0
      Set xOutMail = Nothing
      Set xOutApp = Nothing
      End Sub