Note: The other languages of the website are Google-translated. Back to English
Увійти  \/ 
x
or
x
Реєстрація  \/ 
x

or

Як автоматично надсилати електронну пошту на основі значення комірки в Excel?

Припустимо, ви хочете надіслати електронне повідомлення через Outlook певному одержувачу на основі вказаного значення комірки в Excel. Наприклад, коли значення комірки D7 на аркуші перевищує 200, електронна пошта створюється автоматично. Ця стаття представляє метод VBA для швидкого вирішення цієї проблеми.

Автоматично надсилати повідомлення електронної пошти на основі значення комірки з кодом VBA


Автоматично надсилати повідомлення електронної пошти на основі значення комірки з кодом VBA

Будь ласка, виконайте наступні дії, щоб надіслати електронне повідомлення на основі значення комірки в Excel.

1. На робочому аркуші вам потрібно надіслати електронне повідомлення на основі його значення комірки (тут написано клітинку D7), клацніть правою кнопкою миші вкладку аркуша та виберіть Переглянути код з контекстного меню. Дивіться знімок екрана:

2. У спливаючому Microsoft Visual Basic для додатків вікно, скопіюйте та вставте наведений нижче код VBA у вікно коду аркуша.

Код VBA: надсилання електронної пошти через Outlook на основі значення комірки в Excel

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 = "" і Прихована копія = "" розділи.

5. Нарешті змініть тему електронного листа в рядку .Subject = "відправити тестом значення комірки".

3 Натисніть кнопку інший + Q клавіші разом, щоб закрити Microsoft Visual Basic для додатків вікна.

Відтепер, коли значення, яке ви вводите в комірку D7, перевищує 200, електронна пошта із зазначеними одержувачами та тілом буде автоматично створюватися в Outlook. Ви можете натиснути послати , щоб надіслати цей електронний лист. Дивіться знімок екрана:

примітки:

1. Код VBA працює лише тоді, коли ви використовуєте Outlook як програму електронної пошти.

2. Якщо введені дані в комірці D7 є текстовим значенням, також з’явиться вікно електронної пошти.


Легко надсилайте електронну пошту через Outlook на основі полів створеного списку розсилки в Excel:

повне г, повне г,, показали, від, номер, XNUMX Надіслати електронні листи корисність Kutools для Excel допомагає користувачам надсилати електронну пошту через Outlook на основі створеного списку розсилки в Excel.
Завантажте та спробуйте зараз! (30-денний безкоштовний маршрут)


Статті по темі:


Найкращі інструменти для підвищення продуктивності офісу

Kutools для Excel вирішує більшість ваших проблем і збільшує продуктивність на 80%

  • Повторне використання: Швидко вставте складні формули, діаграми і все, що ви використовували раніше; Шифрувати комірки з паролем; Створити список розсилки та надсилати електронні листи ...
  • Супер формула бар (легко редагувати кілька рядків тексту та формули); Макет читання (легко читати та редагувати велику кількість комірок); Вставте у відфільтрований діапазон...
  • Об’єднати клітинки / рядки / стовпці без втрати даних; Вміст розділених комірок; Об'єднати повторювані рядки / стовпці... Запобігання дублюючим клітинам; Порівняйте діапазони...
  • Виберіть Повторюваний або Унікальний Рядки; Виберіть Пусті рядки (усі клітинки порожні); Супер знахідка та нечітка знахідка у багатьох робочих зошитах; Випадковий вибір ...
  • Точна копія Кілька клітинок без зміни посилання на формулу; Автоматичне створення посилань на кілька аркушів; Вставте кулі, Прапорці та інше ...
  • Витяг тексту, Додати текст, Видалити за позицією, Видаліть пробіл; Створення та друк проміжних підсумків підкачки; Перетворення вмісту комірок та коментарів...
  • Супер фільтр (зберегти та застосувати схеми фільтрів до інших аркушів); Розширене сортування за місяцем / тижнем / днем, частотою та іншим; Спеціальний фільтр жирним, курсивом ...
  • Поєднайте робочі зошити та робочі аркуші; Об’єднати таблиці на основі ключових стовпців; Розділіть дані на кілька аркушів; Пакетне перетворення xls, xlsx та PDF...
  • Понад 300 потужних функцій. Підтримує Office / Excel 2007-2019 та 365. Підтримує всі мови. Простота розгортання на вашому підприємстві чи в організації. Повна функція 30-денної безкоштовної пробної версії. 60-денна гарантія повернення грошей.
вкладка kte 201905

Вкладка Office забезпечує інтерфейс з вкладками для Office і значно спрощує вашу роботу

  • Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
  • Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
  • Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!
дно офісної таблиці
Say something here...
symbols left.
You are guest
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.
    karthick · 1 years ago
    Dear all kindly help me …… my requirement as follow..!!

    I will be having a workbook in which there will be set of data

    then i'll be manually entering a date as a value in a cell
    when the actual date matches with my manual entered date
    excel has to automatically trigger a mail in OUTLOOK with so and so data along with a body of letter to recipient and also cc

    thanks a lot in advance
  • To post as a guest, your comment is unpublished.
    crystal · 1 years ago
    @raguirre76@gmail.com Hi Robert,
    Supposing you want to refer to cell A7 on the worksheet, please apply the below code.

    Dim xRg As Range
    'Update by Extendoffice 2019/12/13
    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 Rng = Selection.SpecialCells(xlCellTypeVisible)
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
    Range("A7") & vbNewLine & _
    "Best Regards"

    On Error Resume Next
    With xOutMail
    .To = ""
    .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.
    crystal · 1 years ago
    @Ganesh Hi Ganesh,
    Please apply the below code. Hope I can help.

    Dim xRg As Range
    'Update by Extendoffice 2019/12/13
    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 & _
    Range("A7") & vbNewLine & _
    Range("B7") & vbNewLine & _
    Range("C7") & vbNewLine & _
    "Best Regards"

    On Error Resume Next
    With xOutMail
    .To = ""
    .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.
    crystal · 1 years ago
    @Edward Hi Edward,
    The code can't work without Outlook. Sorry for the inconvenience.
  • To post as a guest, your comment is unpublished.
    raguirre76@gmail.com · 1 years ago
    How can I refer to a cell on the worksheet to include in the email automatically?
  • To post as a guest, your comment is unpublished.
    tarti.s689@gmail.com · 1 years ago
    Crystal you're the best.

    I want to download the data to be checked with a SQL query, what do I have to do to make the code below work then, at the moment it only works manually.
    Thank you


    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRg As Range
    On Error Resume Next
    If (Target.Count > 1) Then Exit Sub
    Set xRg = Intersect(Target, Range("Z:Z"))
    If xRg Is Nothing Then Exit Sub
    If UCase(Target.Value) = "HOT" Then
    Call Mail_small_Text_Outlook(Target)
    End If
    End Sub
    Sub Mail_small_Text_Outlook(ByVal xCell As Range)
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hello Team" & vbNewLine & vbNewLine & _
    "Lot " & Range("D" & xCell.Row) & "'s Priority has changed to HOT, please prioritize this lot."
    On Error Resume Next
    With xOutMail
    .To = "Email Address1; Email Address2; Email Address3; Email Address4; Email Address5"
    .CC = ""
    .BCC = ""
    .Subject = "Lot number is " & Range("D" & xCell.Row)
    .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.
    Nano22 · 1 years ago
    Crystal you're the best.
    what do i have to add to make the code work with formulas ?
    Thank you

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRg As Range
    On Error Resume Next
    If (Target.Count > 1) Then Exit Sub
    Set xRg = Intersect(Target, Range("B:B"))
    If xRg Is Nothing Then Exit Sub
    If UCase(Target.Value) = "Yes" Then
    Call Mail_small_Text_Outlook(Target)
    End If
    End Sub
    Sub Mail_small_Text_Outlook(ByVal xCell As Range)
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hello Team" & vbNewLine & vbNewLine & _
    "Lot " & Range("A" & xCell.Row) & "'s Priority has changed to Yes, please prioritize this lot."
    On Error Resume Next
    With xOutMail
    .To = "Email Address1; Email Address2; Email Address3; Email Address4; Email Address5"
    .CC = ""
    .BCC = ""
    .Subject = "Lot number is " & Range("A" & xCell.Row)
    .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.
    prasana05@gmail.com · 1 years ago
    I need help with Excel to send an automatic email using outlook when a cell value is changed in the file.

    Question . Sheet name "Attrition Report" Column L in the file has the list of RAG status, So, when one of the manager will choose the options (Green, Red, Amber) for possible attrition cases. When the cell value changes to Red or Amber ; excel should automatically send an email ONLY when it changes to RED or Amber. The body of the email should show employee name which is in Cell range "B" and the RAG status which is in Range "L".
    I put the code but i guess it's incorrect.

    Any help on this will be much appreciated.

    Thanks and Regards

    Emanuel Prasanna Kumar

    The code i currently have. is.

    _______________

    Dim xRg As Range
    Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
    For Each xRg In Range("L2:L100")
    If CInt(xRg.Value) = "Red" And "Amber" Then
    Call Mail_small_Text_Outlook
    End If
    Next
    End Sub
    Sub Mail_small_Text_Outlook()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Dim xIntR As Integer
    xIntR = xRg.Row
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
    "Emp Name. :" & Range("B" & xIntR).Value & vbNewLine & _
    "RAG Status :" & Range("L" & xIntR).Value & vbNewLine & _
    "Factor :" & Range("K" & xIntR).Value & vbNewLine
    On Error Resume Next
    With xOutMail
    .To = "Emanuel.Kumar@infovision.com"
    .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.
    rajeshwariagale04@gmail.com · 1 years ago
    How can I display the Sheet name and list of cells which has value more than 200 in the email content?
  • To post as a guest, your comment is unpublished.
    ClaireC · 1 years ago
    Hello,
    How do I get excel to send an email automatically when the worksheet is opened based on a cell value?
  • To post as a guest, your comment is unpublished.
    Claire · 1 years ago
    Hello,

    How can i get excel to send an email automatically when the workbook is opened based on a cell value, instead of when the cell value is changed?
  • To post as a guest, your comment is unpublished.
    joseph · 1 years ago
    I want to add different email address per row, but when I change one row, the entire worksheet changes. How can I limit the changes only to one row each per one email account?
  • To post as a guest, your comment is unpublished.
    mshreyascse@gmail.com · 1 years ago
    Hi All,
    Can someone help me to figure out the below
    I have an Excel sheet with loads of worksheets in it.
    Data is entered in 3 worksheets on daily basis and information from these 3 sheets is sent out to mailing list on every Sunday (data accumulated from Last Sunday to Saturday in those 3 work sheets).
    This XL sheet is stored in share point.
  • To post as a guest, your comment is unpublished.
    Katie · 1 years ago
    Hi Crystal,
    Thank you for this code. It is extremely helpful. I am trying to add a few things to it and was wondering if you or someone following this post could help.

    How can you add Cell Text from the same Range (row) to the Mail Body?
    How can you get the code to send an email for every Cell in the Range that is over an amount?

    Thank you so much!
  • To post as a guest, your comment is unpublished.
    RobArchibald · 1 years ago
    @RobArchibald Actually, more to the point - how do I make it so that only one email is created when I open the workbook, but not just when I make a change to it? Currently changing any cell results in a new email being created.

    Please help with this last hurdle, I'm so close!
  • To post as a guest, your comment is unpublished.
    RobArchibald · 1 years ago
    Hi Crystal,
    Thank you for your extremely useful posts! I have the VBA code working perfectly for our purposes, except for one problem - when I open the workbook or make a change, each email is created twice. What can be done to ensure each email is only created once?

    Many thanks, Rob

    My current code:

    Dim xRg As Range
    'Update by Extendoffice 2019/8/2
    Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Intersect(Range("A1"), Target)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value = 1 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 = "Dear " & Range("C3") & "," & vbNewLine & vbNewLine & _
    "I am writing to inform you that the Form D filing for " & Range("C2") & " is due on " & Range("C4") & ". All securities offerings that rely on the exemptions set forth under Regulation D are required to file a Form D every year for as long as the offering is open." & vbNewLine & vbNewLine & _
    "It is advised that " & Range("C2") & " should maintain its Form D filing if it continues to offer securities in reliance on Regulation D. Maintaining an up-to-date Form D is important in ensuring compliance with federal and state securities regulations." & vbNewLine & vbNewLine & _
    "Please let us know at your earliest convenience if you wish to arrange the renewal of the Form D." & vbNewLine & vbNewLine & _
    "Thank you," & vbNewLine
    On Error Resume Next
    With xOutMail
    .To = Range("C5")
    .CC = "t.kim@geracillp.com"
    .BCC = ""
    .Subject = "Form D filing notice for " & Range("C2")
    .Body = xMailBody
    .Display 'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
    End Sub

    Private Sub Worksheet_Calculate()
    Dim xI As Integer
    Dim xRg As Range
    Set xRg = Range("A1")
    On Error GoTo Err01
    xI = Int(xRg.Value)
    If xI = 1 Then
    Call Mail_small_Text_Outlook
    End If
    Err01:
    End Sub
  • To post as a guest, your comment is unpublished.
    Viji · 1 years ago
    How to insert the images in email body
  • To post as a guest, your comment is unpublished.
    Edward · 1 years ago
    I Keep Getting this:

    Run-time error '429':

    ActiveX component can't create object

    I use apple and don't have outlook... is there a way to make this work without outlook.. and

    instead Mail Version 11.5 (3445.9.1) apple
  • To post as a guest, your comment is unpublished.
    crystal · 1 years ago
    @ricardo27 Hi,
    Please replace the line "If IsNumeric(Target.Value) And Target.Value > 200 Then" with "If Target.Value = "test" Then"
    "test" is the specific word you will cal out the email based on, please change it to your own word.
  • To post as a guest, your comment is unpublished.
    crystal · 1 years ago
    @ricardo27 Hi ricardo suarez,
    The below VBA code can solve your problem. Please have a try and thank you for your comment.

    Dim xRg As Range
    'Update by Extendoffice 2019/8/14
    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
    For Each cell In Range("A36:A38")
    If cell.Value Like "?*@?*.?*" Then
    strto = strto & cell.Value & ";"
    End If
    Next cell
    If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)
    Application.ScreenUpdating = False
    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 = strto
    .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.
    crystal · 1 years ago
    @amy786 Hi Anisa,
    Sorry can't help you with that. Thank you for your comment.
  • To post as a guest, your comment is unpublished.
    Ganesh · 1 years ago
    Thank you for posting valuable and important VBA code. I am new in VBA coding and trying to modify your VBA with editing Mail Body;

    ...
    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
    "This is line 1" & vbNewLine & _
    "This is line 2"
    On Error Resume Next
    ...

    How to add Cell Text Ex. text from A7, B7 & C7 related to D7 into Mail Body instead of other text. Could someone please guide me. Thank you in advance.
  • To post as a guest, your comment is unpublished.
    Rodrigo · 1 years ago
    @crystal I think what he's also trying to say (beside the dynamics in the subject of the email) is that by setting a range of cells that can trigger the email, you wont know what that change was and where.

    With a single cell instead of a range you'll know exactly where to look once you get the email or you can even add the value that triggered the email in the email body, as I read above by specifying the single cell you're trying to track.

    But when you specify a range, how can you add in the body of the email the value and cell or column that started the whole action? How do I know what and where the change happened?
  • To post as a guest, your comment is unpublished.
    ricardo27 · 1 years ago
    I have another question, how do you write in VBA so instead of "If IsNumeric(Target.Value) And Target.Value > 200 Then" (detecting a value greater than 200 it detects any text input..... for example in cell D7 you write any words (not number but words) it calls out the email ! please respond
  • To post as a guest, your comment is unpublished.
    ricardo27 · 1 years ago
    Hi

    I got a question, on excel I have a column with several emails written (they are formulated), for example A36 is example1@hotmail.com, A37 is example2@hotmail.com, A38 is example3@hotmail.com, I want that the part of the programming VBA To: Range (A36:A38) so they send the email to each of those wroten emails, the thing is that I put it like this To: Range (A36:A38) but it does not work, am I doing it wrong?
  • To post as a guest, your comment is unpublished.
    otorodriguez26@gmail.com · 1 years ago
    @crystal Thank you very much ! Crystal
  • To post as a guest, your comment is unpublished.
    KAYDEN · 1 years ago
    @crystal Dear Crystal,

    Yes, you are correct. I'd like to have a dynamic subject line to reflect the name of fruit! Sorry I was ambiguous on my asking, but you understood perfectly! Do you think there's a code that I can use to make this work? Thank you again for your help!
  • To post as a guest, your comment is unpublished.
    amy786 · 1 years ago
    Hi


    My vba code works fine, even the email part to outlook. I'm quite chuffed as I am a novice at vba. I created an automated process to create an invoice and email in pdf.


    However the next step is I want to include a status on the excel spreadsheet, which is my database to say "complete" or "sent". I'm thinking maybe an IF formula? I don't want to use a message box. Basically I just want to keep record that for each creditor the email has been sent.


    How would I do that in VBA


    Thanks for your help:)
  • To post as a guest, your comment is unpublished.
    crystal · 1 years ago
    @Roxiann Hi Roxiann,
    Supposing you want to send email to address in cell E159, and display value of cell A1 in your email body, you can try the below VBA code. Thanks for your comment.

    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 & _
    Range("A1") & vbNewLine & _
    "This is line 2"
    On Error Resume Next
    With xOutMail
    .To = Range("E159")
    .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.
    crystal · 1 years ago
    @Otoniel Or just include this line Range("D7") & vbNewLine & _ in the xMailBody line.

    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
    "This is line 1" & vbNewLine & _
    Range("D7") & vbNewLine & _
    "This is line 2"
  • To post as a guest, your comment is unpublished.
    crystal · 1 years ago
    @Otoniel Hi Otoniel,
    Supposing the cell D7 is in the worksheet named "Sheet2", please change the xMailBody line in above code to
    xMailBody = "The value of D7 is" & ThisWorkbook.Sheets("Sheet2").Cells(7, 4).Value

    Don't forget to change the sheet name and the cell number as you need (here Cells(7,4) represents cell D7 which locationg in row 7 column 4).
  • To post as a guest, your comment is unpublished.
    crystal · 1 years ago
    @Toph42 Good day,
    The below VBA code will do you a favor.

    Dim xRg As Range
    'Update by Extendoffice 2019/8/2
    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

    Private Sub Worksheet_Calculate()
    Dim xI As Integer
    Dim xRg As Range
    Set xRg = Range("D7")
    On Error GoTo Err01
    xI = Int(xRg.Value)
    If xI > 200 Then
    Call Mail_small_Text_Outlook
    End If
    Err01:
    End Sub
  • To post as a guest, your comment is unpublished.
    Roxiann · 1 years ago
    Hi. I am trying to use your code and I get the email but I want the email address I have in cell E159 to pop up as the email address. I also want to Display a cell value in the middle of my email. I have tried several ways and none seem to work. I cannot use the kudotools app. I only have excel and the vba.
  • To post as a guest, your comment is unpublished.
    Otoniel · 1 years ago
    Hi Crystal, thanks for the last answer, i got a quick question, how can i add the cell value automatically to the mailbody
  • To post as a guest, your comment is unpublished.
    crystal · 1 years ago
    @KAYDEN HI KAYDEN,
    Do you mean the subject line is dynamically changed based on the target value of the Qty column? When Qty of Mango fell below target value of 200, send email with subject line "Please order Mango (refers to cell B2)"; When Qty of another fruit fell below target value of 200, send email with subject line of the corresponding fruit name?
  • To post as a guest, your comment is unpublished.
    Jim · 1 years ago
    @crystal 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.
    KAYDEN · 1 years ago
    @crystal Hello Crystal,

    Thank you very much for your response! I'd like to elaborate an issue I have. I have a range of cells as "target". When email is generated, on Subject line, I'd like to add a cell that triggered this email. For instance, Qty of Mango fell below target value of 200, then I'd like to add Please order "Mango" on the subject line. Since the target is a range, I'd want some type of formula that can refer to cell B2 (Mango - name of the fruit column). I hope you could help me out on this! Thanks once again!
  • To post as a guest, your comment is unpublished.
    crystal · 1 years ago
    @Paras Hi Paras,
    In the code, please replace the .Display line with .Send. Thanks for your comment.
  • To post as a guest, your comment is unpublished.
    crystal · 1 years ago
    @Otoniel Hi Otoniel,
    In the code, please replace the .Display line with .Send. Thanks for your comment.
  • To post as a guest, your comment is unpublished.
    crystal · 1 years ago
    @Kayden Hi Kayden,
    If you want to specify a range of cells rather than single cell, the below VBA code can help. But I don't really understand your last question about "so I can add this to email subject". Thanks for your comment.

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Intersect(Target, Range("D1:E20")) = 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
    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 = ""
    .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.
    crystal · 1 years ago
    @Dmytro Hi Dmytro,
    Sorry for the inconvenience. You just need to copy the text lines without the line numbers. The code only works when the criterion met (In this case, when value in cell D7 is changed to more than 200, the code will work).
    Thanks for your comment.
  • To post as a guest, your comment is unpublished.
    crystal · 1 years ago
    @Justin Hi Justin,
    Replace the .Display with .Send in the code will automtically send the email as soon as the criterion met.
    Popping up the email can help readers to test the code when following the steps.
    Thanks for your comment.
  • To post as a guest, your comment is unpublished.
    crystal · 1 years ago
    @Sophie Hi Sophie,
    Please change the > 200 to =0 to make it work.Thanks for your comment.
  • To post as a guest, your comment is unpublished.
    Paras · 1 years ago
    This is great but just the last step is not completing my request. Could you please update so it automatically sends out the email, without clicking send.
  • To post as a guest, your comment is unpublished.
    dalton · 1 years ago
    I am having a similar issue as has been brought up, the VBA works with manually values. I have 2 workbooks, I hope to pull data from workbook 2 into workbook1. Workbook 1 then subtracts 2 numbers, one of which is pulled from workbook2 (via using formula of =value in cell in workbook 2). Then if the difference is less than a given number, I hope to send an email. When I manually enter the number the VBA works great. When I use the = value of cell in workbook 2, VBA does not run. I feel so close but still out of arms length. Any help is greatly appreciated. Thanks much.
  • To post as a guest, your comment is unpublished.
    Otoniel · 1 years ago
    Hello is it possible, that instead of popping up the email.

    Can it be configured to automatically send the mail, without the need to send it manually?
  • To post as a guest, your comment is unpublished.
    Toph42 · 1 years ago
    Is there was a way to prompt the email by cells that are populated by a formula? This seems to only work when populating the cells manually. Thanks!
  • To post as a guest, your comment is unpublished.
    Kayden · 2 years ago
    I've set this VBA to range instead of a single cell. However, I'd like to specify which cell value has triggered this email to be sent. Let say, Value on D3 is greater than 200, that triggered this email message from range (D1:E20). How can I embed this code into VBA, so I can add this to email subject? any help would be greatly appreciated!
  • To post as a guest, your comment is unpublished.
    Dmytro · 2 years ago
    Hi! How should I copy/paste the code to get it to work? (after copying/pasting with line number and line text it shows up "invalid outside procedure"; copying/pasting only text lines without line numbers it does nothing after changing the cell value).
  • To post as a guest, your comment is unpublished.
    Justin · 2 years ago
    so when you say "Automatically Send Email Based On Cell Value" you really mean make outlook pop up so you can manually press the send button? or am I missing something?