· 18 days ago
how to change this to support a date, i have a service schedule - so i would like an email sent once my date has expired - or remind me 30 days before
Как автоматически отправлять электронную почту на основе значения ячейки в 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 и Bcc по мере необходимости в .CC = "" и Скрытая копия = "" разделов.
5. Наконец, измените тему письма в строке. .Subject = "проверка значения ячейки".
3. нажмите другой + Q ключи вместе, чтобы закрыть Microsoft Visual Basic для приложений окно.
С этого момента, когда значение, которое вы вводите в ячейку D7, больше 200, электронное письмо с указанными получателями и телом будет автоматически создано в Outlook. Вы можете нажать на Отправить кнопку, чтобы отправить это письмо. Смотрите скриншот:
Заметки:
1. Код VBA работает только при использовании Outlook в качестве почтовой программы.
2. Если данные, введенные в ячейку D7, представляют собой текстовое значение, также появится окно электронной почты.
Легко отправлять электронную почту через Outlook на основе полей созданного списка рассылки в Excel:
Освободи Себя Отправить письма полезности Kutools for Excel помогает пользователям отправлять электронную почту через Outlook на основе созданного списка рассылки в Excel.
Скачайте и попробуйте прямо сейчас! (30-дневная бесплатная трасса)
Статьи по теме:
- Как отправить электронное письмо через Outlook, когда книга сохранена в Excel?
- Как отправить электронное письмо, если определенная ячейка изменена в Excel?
- Как отправить электронное письмо, если в Excel нажата кнопка?
- Как отправить электронное письмо, если срок в Excel соблюден?
- Как отправить напоминание или уведомление по электронной почте, если книга обновлена в Excel?
Лучшие инструменты для работы в офисе
Kutools for Excel решает большинство ваших проблем и увеличивает вашу производительность на 80%
- Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма ...
- Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон...
- Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы... Предотвращение дублирования ячеек; Сравнить диапазоны...
- Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор ...
- Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое ...
- Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии...
- Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом ...
- Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF...
- Более 300 мощных функций. Поддерживает Office / Excel 2007-2019 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.
Вкладка Office: интерфейс с вкладками в Office и упрощение работы
- Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
- Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
- Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
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.
- To post as a guest, your comment is unpublished.
- To post as a guest, your comment is unpublished.
- To post as a guest, your comment is unpublished.Hi I am trying to use this VBA Code to use as an automated email resolution so I can notify my colleague that an invoice is resolved from a Dispute. So on the first part of the code I was able to make use of it'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("D1:D99"), Target)
If xRg Is Nothing Then Exit Sub
If Target.Value = "Resolve" Then
Call Mail_small_Text_Outlook
End If
End SubHowever my dilemma comes in when I am at the code belowSub 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 here"
.CC = ""
.BCC = ""
.Subject = "send by cell value test"
.Body = xMailBody
.Send 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End SubSo what I wanted it to happen is that I want it to send an email with an email body that includes the invoice number from a specific cell so let say for example I marked "D7 as resolved I want the email body to include the invoice number in Cell C7 and so on and so forth.Thank you in advance.- To post as a guest, your comment is unpublished.I want this code to sayxMailBody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"Hi Everyone,This is confirm that Invoice <Then Invoice Number from a specific Cell> was marked as Resolved.Please let us know if you need further assistance.Then I also want it to include my outlook saved signature.
- To post as a guest, your comment is unpublished.Hi,
This is fantastic.
Is there a way for each cell to provide a deifferent email address.
E.g If cell B7 triggers an email to info@example.com, can cell B8 trigger an email to start@tech.com?
Cheers! - To post as a guest, your comment is unpublished.
- To post as a guest, your comment is unpublished.Hello ,
I am new here , your code is doing me a great , but I am having a small problem , the cell value in D7 for me is changing automatically , and it is either blank or has value 1 , when it is value 1 it triggers the email , that works fine , the problem is that it keeps sending emails when the D7=1 , is there a way to make it send only 1 email instead of keep sending ?
Thanks - To post as a guest, your comment is unpublished.
- To post as a guest, your comment is unpublished.hi My name Is ashish, If someone changes any data in the axle sheet, the system should automatically shoot the mail to the authorized person, how would that happen?
- To post as a guest, your comment is unpublished.Hi, could anyone help I'm trying to send emails to a different address when a name is entered into a particular cell do I need to adjust this code or have a new piece of code for each address i.e if cell = AA then send to AA@hotmail.com or if cell = BB then send to BB@hotmail.com etc.
- To post as a guest, your comment is unpublished.
- To post as a guest, your comment is unpublished.Hi, I've been able to create an email with content, but now I'm trying to extract data from a specified cell related to the initial query. How do I get that data to show in the email Body with the below code? I've tried linking with a vLookUp function to extract that data. So basically, how do I get in the main example above, "This is line 1" to show the Data being pulled for xData below
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2017/9/12
Dim xRgSel As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String
Dim xData As Object
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set xRg = Range("J:J")
Set xRgSel = Intersect(Target, xRg)
Set xData = Application.WorksheetFunction.VLookup(xRgSel, Range("Data_Table"), 6, False)
ActiveWorkbook.Save
If Not xRgSel Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xMailBody = xData & "Cell(s) " & xRgSel.Address(False, False) & _
" in the worksheet '" & Me.Name & "' were modified on " & _
Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
" by " & Environ$("username") & " in https://textmgmt.sharepoint.com/:x:/r/sites/EmailManagedServiceCollaboration/Documents/(%20Test)%20Shared%20TM%20Tracking%20Document%20-%20Local%20Email%20Campaign.xlsm?d=w7ad2f1404d574b9abb529ec248453f42&csf=1&web=1&e=zg9REc ."
With xMailItem
.To = "jason.thompson@textmanagement.co.uk"
.Subject = "Worksheet modified in Brand Approve Column "
.Body = xMailBody
.Send
End With
Set xRgSel = Nothing
Set xOutApp = Nothing
Set xMailItem = Nothing
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
- To post as a guest, your comment is unpublished.Hi, I am stuck with a piece of Code. I have combined a few comments below but can't get it to workI have added the xtarget part of the code in the Mail_small_text_Outlook to select a specific cell to be included as subjectAs a result, nothing works anymore. Could someone help pleaseDim 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("AC9"), Target)
If xRg Is Nothing Then Exit Sub
If Target.Value = 1 Then
ActiveSheet.Calculate
Call Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook(xTarget As Range)
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim xR
xR = xTarget.Row
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = ""
On Error Resume Next
With xOutMail
.To = "email"
.CC = ""
.BCC = ""
.Subject = Cells(xR, 1).Value
.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("AC9")
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.Good day,
Thank you for teaching me something new, I am trying to get excel to send out an email to different sales reps.
So if row X is an error code of "999" then it needs to send an email to the rep I placed the email addresses in row K as it differs for every line, but if row X is "0" it should not send an email.
is this possible? - To post as a guest, your comment is unpublished.
- To post as a guest, your comment is unpublished.Thank you for the fantastic VBA coding, i am learning quite a bit. As I am a little "green" with this skill, i am currently trying to have the macro choose between doing nothing, or sending one of two different email to send based on a cell value. If the cell has noting in it then "do nothing", if the cell has a "1" or a "2" in it choose either "Mail_small_Text_Outlook()" or "Mail_small_Text_Outlook_2()". I can not figure this out and i am reaching out to see if there are some brighter minds that could help me with this.Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("N5"), Target)
If xRg Is Nothing Then Exit Sub
If IsNumeric(Target.Value) And Target.Value = 1 Then
Call Mail_small_Text_Outlook
Exit Sub
ElseIf IsNumeric(Target.Value) And Target.Value = 2 Then
Call Mail_small_Text_Outlook_2
Exit Sub
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 = "" & vbNewLine & vbNewLine & _
On Error Resume Next
With xOutMail
' .SentOnBehalfOfName = ""
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Sub Mail_small_Text_Outlook_2()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "" & vbNewLine & vbNewLine & _
On Error Resume Next
With xOutMail
' .SentOnBehalfOfName = ""
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.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("N5")
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.helloi want to send automatic emails when due date come to the concern departments.i have to apply this to 3 or 4 columnscan you please send me code
- To post as a guest, your comment is unpublished.Hello,If for example a cell in column D is filled in to meet the criteria to auto generate an email. Can this be adapted to pull the information from the row in which has been filled in.ie D7 is filled in so email the contents of A7, B7, C7ie D25 is filled in so email the contents of A25, B25, C25Thanks
- To post as a guest, your comment is unpublished.Hi Ckey1990,The below code can do you a favor, please have a try. Thank you.Dim xRg As Range 'Update by Extendoffice 2020/8/28 Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Target.Cells.Count > 1 Then Exit Sub Set xRg = Intersect(Range("D:D"), Target) If xRg Is Nothing Then Exit Sub If Target.Value = "Done" Then Call Mail_small_Text_Outlook(Target) End If End Sub Sub Mail_small_Text_Outlook(xTarget As Range) Dim xOutApp As Object Dim xOutMail As Object Dim xMailBody As String Dim xR xR = xTarget.Row Set xOutApp = CreateObject("Outlook.Application") Set xOutMail = xOutApp.CreateItem(0) xMailBody = "Hi there" & vbNewLine & vbNewLine & _ Cells(xR, 1).Value & vbNewLine & _ Cells(xR, 2).Value & vbNewLine & _ Cells(xR, 3).Value & vbNewLine 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.I posted before and got a great answer...but moving forward i need more info. I have coulmn "C" listed with 25 different emails. I have column "D" "E" & "F" used for date completions (ex. August 17 = 081720). I need the email body to be different for each of the DEF cells but only go to ONE email in that coresponding row once entered
D3..(EMAIL A) to c3 address, E3(EMAIL B) to c3 address, F3 (EMAIL C) to c3 address
D4..(EMAIL A) to c4 address, E4(EMAIL B) to c4 address, F4 (EMAIL C) to c4 address...
Does this make sense?
- To post as a guest, your comment is unpublished.Thank you for the code, this code works when I enter the value and press enter. But in my case the cell is filling automatically with formula, and when the value is reached it doesn't open the email (the code do not works in this case). I would also like the email body to populate data from the other cells for that line item how would I get it to pull that cell data in reference to the cell that created the email?Any help would be fantastic!
- To post as a guest, your comment is unpublished.Hi Mladen,
I can only help to solve the formula problem for you. Please have a try. Thank you!
Dim xRg As Range
'Update by Extendoffice 2020/08/21
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.Hi !
I have managed to get the coding up and running. However I would like to have the "from" fix from one of my accounts. Several people will be creating this autoresponse so I need to have a fixed "from"
Thank you in advance!- To post as a guest, your comment is unpublished.Hi Thais,
The email will be sent with the default account in your Outlook. If you need a fixed "from", please get into the account settings dialog in your Outlook, and then specify the account as the default one.- To post as a guest, your comment is unpublished.Hi Crystal!Thank you for the tip :-)The issue is that the code for sending the email is on a shared excel. People who mighty choose to send the automated email from this shared excel, are most often not the ones who might be able to answer if someone replies to the automated email. Therefore I would like the automated email to always be from a fixed email, in that way we avoid peopel who send the automated email to get questions. Do you know if this can be fixed? I mean, in the code you can choose the to: and subject:, shouldnt we be able to design the :from?
- To post as a guest, your comment is unpublished.Hi Thais,I got your point. It just like sending an email on behalf of someone.Please add the below line to the code, and don't forget to specify the email address. (After running the code, you will see the From field has a fixed email address).SentOnBehalfOfName = "Email Address"The whole VBA code is as follows.Dim xRg As Range 'Update by Extendoffice 20120/8/28 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 .SentOnBehalfOfName = "Email Address" .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.Thank you for the code ! I'm having a small issue where the code will only select the first cell that meets my criteria
( I want to flag any tasks that are late so were due before the current date, however the code is only taking the first value and not all the values in my excle"
the following is my code, i would be forever grateful if you could help!
Public Sub Late_Task_Email()
'Updated by Extendoffice 2018/11/22
Dim xRgDate As Range
Dim xRgSend As Range
Dim xRgText As Range
Dim xRgDone As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xLastRow As Long
Dim vbCrLf As String
Dim xMailBody As String
Dim xRgDateVal As String
Dim xRgSendVal As String
Dim xMailSubject As String
Dim xStrRang As String
Dim i As Long
On Error Resume Next
Set xRgDate = Range("F12:F500")
Set xRgDate = Range(xStrRang)
Set xRgSend = Range("B12:B500")
Set xRgSend = Range(xStrRang)
Set xRgText = Range("A12:A500")
Set xRgText = Range(xStrRang)
xLastRow = xRgDate.Rows.Count
Set xRgDate = xRgDate(1)
Set xRgSend = xRgSend(1)
Set xRgText = xRgText(1)
Set xOutApp = CreateObject("Outlook.Application")
For i = 1 To xLastRow
xRgDateVal = ""
xRgDateVal = xRgDate.Offset(i - 1).Value
If xRgDateVal <> "" Then
If CDate(xRgDateVal) - Date < 0 Then
xRgSendVal = xRgSend.Offset(i - 1).Value
xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
vbCrLf = "
"
xMailBody = ""
xMailBody = xMailBody & "Dear DOE,"
xMailBody = xMailBody & "This task is OVERDUE!"
xMailBody = xMailBody & ""
Set xMailItem = xOutApp.CreateItem(0)
With xMailItem
.Subject = xMailSubject
.To = xRgSendVal
.HTMLBody = xMailBody
.Display
'.Send
End With
Set xMailItem = Nothing
End If
End If
Next
Set xOutApp = Nothing
End Sub
- To post as a guest, your comment is unpublished.
- To post as a guest, your comment is unpublished.Hi Crystal, thank you for sharing this awesome code! I changed the code to function with text so when a cell has anything typed in, it prompts the email function. My question is, how can I code the email to auto-populate the row and column header info for a specific cell along with text? Here are the ranges of data with text:
Subject "(A3:A50) - (Q1:AC1) - Pending"
Mail Body "(P1:AB1) complete."
"Please prepare the (Q1:AC1)"
'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("P3:AB50"), Target)
If xRg Is Nothing Then Exit Sub
If Target.Value > 0 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 = "Hello," & vbNewLine & vbNewLine & _
"Create Bid Comparison step complete." & vbNewLine & _
"Please prepare the Recommendation of Award." & vbNewLine & vbNewLine & _
"Thank you"
On Error Resume Next
With xOutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = ("Project 20-20")
.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.To better clarify, I am hoping to auto-populate the column and row headers into the email, along with text.
Subject "(A3:A50) - (Q1:AC1) - Pending"
Mail Body "(P1:AB1) complete."
"Please prepare the (Q1:AC1)"
(i.e. C12, the headers for the subject line would be A12 and C1. C12 for the 1st line in the "Mail Body" and D12 for the 2nd.)
This way, any cell I enter data into will prompt the email and pull the headers in pertaining to that cell.
Thank you!
- To post as a guest, your comment is unpublished.Hello
I need a help. I use VB code for automatically to send email based on cell value in Excel. The thing is that this code works when I enter the value and press enter. But in my case the cell is filling automatically with formula, and when the value is reached it doesn't open the email (the code do not works in this case). Ex.
- To post as a guest, your comment is unpublished.Hey Crystal,
I'd like to set automatic emails based on drop options of Update Request, Complete or More Info in Cell I. Update Request will send an email to three different email addresses and Complete or More Info will send an email to one email address. Also, how do to I write each Range to equal data that corresponds to the row with the drop down option.
My data below only triggers off Update Request for a specific range (b3). Help!
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("I:I"), Target)
If xRg Is Nothing Then Exit Sub
If Target.Value = "Update Request" 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 = "All," & vbNewLine & vbNewLine & _
"Updates have been entered into the maintenance log:" & vbNewLine & _
Range("b3") & vbNewLine & _
Range("c3") & vbNewLine & _
Range("d3") & vbNewLine & vbNewLine & _
"Thanks," & vbNewLine & _
"Training Team"
With xOutMail
.To = "ShondaX@yahoo.com"
.CC = ""
.BCC = ""
.Subject = "Log Update Requests"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Thanks, Shonda - To post as a guest, your comment is unpublished.
- To post as a guest, your comment is unpublished.Is there a way to send emails to individual recipients that can be pulled from another cell in the same row?
- To post as a guest, your comment is unpublished.Hi Tyson nold,
Supposing the recipient's email address is in F7, please apply the below code.
Dim xRg As Range
'Update by Extendoffice 2020/7/17
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 = Range("F7")
.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.That only pulled the information for that cell. If you are only sending one email for the D7 cell this works but how do you get it to change to another cell for the next value in column D? As in if the next value over 200 is D10 how do you get the email to auto pull the information from F10 instead of F7? That's the issue I'm running into right now.Thank you!
- To post as a guest, your comment is unpublished.
- To post as a guest, your comment is unpublished.
- To post as a guest, your comment is unpublished.I want my email to send when any of the cells in row H are changed to a specific value, which is one of 3 drop down options (Ready for Inventory) set for that row. How do I modify this coding to that instead of a manually entered value? Thanks!!
- To post as a guest, your comment is unpublished.Hi Brittany,
Supposing there are drop down lists in column H, and you want to trigger an email when selecting "Done" from the drop-down, please try the below VBA to get it down.
Dim xRg As Range
'Update by Extendoffice 2020/6/12
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("H:H"), Target)
If xRg Is Nothing Then Exit Sub
If Target.Value = "Done" 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
- To post as a guest, your comment is unpublished.HelloI need a help. I use VB code for automatically to send email based on cell value in Excel. The thing is that this code works when I enter the value and press enter. But in my case the cell is filling automatically with formula, and when the value is reached it doesn't open the email (the code do not works in this case).
- To post as a guest, your comment is unpublished.Hi Mladen,
Try the below code.
Dim xRg As Range
'Update by Extendoffice 2012/08/07
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.
- To post as a guest, your comment is unpublished.This is great but I need it to pull information from other cells on the same row that is triggering the email... Can anyone help?
- To post as a guest, your comment is unpublished.
- To post as a guest, your comment is unpublished.
- To post as a guest, your comment is unpublished.Cystal,
This is definitely a time saver. I want to know what I would have to add to the vba to include my signature line on the outgoing email. On my usual emails, I have a signature line with company logo and contact info. I want to include that so the email looks just like it would if I had sent myself manually from Outlook. Many thanks!
Mike- To post as a guest, your comment is unpublished.Hi darkgyft.
Try the below VBA code. Hope I can help. thank you.
Dim xRg As Range
'Update by Extendoffice 2020/05/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)
On Error Resume Next
With xOutMail
.Display 'or use .Send
.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "send by cell value test"
.HTMLBody = "This is a test email sending in Excel" & "
" & .HTMLBody
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
- To post as a guest, your comment is unpublished.Hi - I tried to use the code, it works fine when cell value D7 is changed manually. if D7 value changed using any formula i.e vlookup or IF .code doesnt trigger. Code trigger only when any cell on the sheet is change keeping D7 value above 200. is there any wayout for the problem . regards srini
- To post as a guest, your comment is unpublished.Hi,
The below VBA code can help you solve the problem. Please have a try. Thank you.
Dim xRg As Range
'Update by Extendoffice 20120/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"
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.
- To post as a guest, your comment is unpublished.
- To post as a guest, your comment is unpublished.Hi all - I am trying to use this code but when I exit the developer and test the cell- it is over the specifications, but nothing happens. I don't receive a pop up to send the email? But when I run the code in developer it comes up - its just when I'm within the spreadsheet and change the cell, nothing happens. I have copied and edited the code as per instructions.
- To post as a guest, your comment is unpublished.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.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.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 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.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.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.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.
- To post as a guest, your comment is unpublished.
- To post as a guest, your comment is unpublished.
- To post as a guest, your comment is unpublished.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.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.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.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.
- To post as a guest, your comment is unpublished.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.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.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.I have the exact situation but only difference is ...I have got around 100 rows to check. So it has to check each row on column D if any cell on column D meets the criteria it has to add info from column A B and C for respective D cell and after checking all 100 rows it has to send one email.
