Note: The other languages of the website are Google-translated. Back to English
Autentificare  \/ 
x
or
x
Înregistrare  \/ 
x

or

Cum să trimiteți automat e-mailuri pe baza valorii celulei din Excel?

Presupunând că doriți să trimiteți un e-mail prin Outlook unui anumit destinatar pe baza unei valori de celulă specificate în Excel. De exemplu, când valoarea celulei D7 într-o foaie de lucru este mai mare de 200, atunci se creează automat un e-mail. Acest articol introduce o metodă VBA pentru a rezolva rapid această problemă.

Trimiteți automat e-mail pe baza valorii celulei cu cod VBA


Trimiteți automat e-mail pe baza valorii celulei cu cod VBA

Vă rugăm să procedați după cum urmează pentru a trimite un e-mail pe baza valorii celulei din Excel.

1. În foaia de lucru trebuie să trimiteți e-mail pe baza valorii sale de celulă (aici spune celula D7), faceți clic dreapta pe fila foaie și selectați Afișați codul din meniul contextual. Vedeți captura de ecran:

2. În fereastra pop-up Microsoft Visual Basic pentru aplicații fereastra, vă rugăm să copiați și să lipiți codul VBA de mai jos în fereastra codului foii.

Cod VBA: trimiteți e-mail prin Outlook pe baza valorii celulei din 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

notițe:

1. În codul VBA, D7 valoare> 200 sunt celula și valoarea celulei pe care veți trimite e-mail pe baza.

2. Vă rugăm să schimbați corpul e-mailului după cum aveți nevoie xMailBody linie în cod.

3. Înlocuiți adresa de e-mail cu adresa de e-mail a destinatarului în linie .To = "Adresă de e-mail".

4. Și specificați destinatarii Cc și Bcc după cum doriți .CC = „” Cco = „” secțiuni.

5. În cele din urmă, schimbați subiectul e-mailului în linie .Subject = "trimite prin testul valorii celulei".

3. apasă pe Alt + Q tastele împreună pentru a închide Microsoft Visual Basic pentru aplicații fereastră.

De acum înainte, când valoarea pe care o introduceți în celula D7 este mai mare de 200, un mesaj de e-mail cu destinatarii și corpul specificați va fi creat automat în Outlook. Puteți face clic pe Trimite pentru a trimite acest e-mail. Vedeți captura de ecran:

notițe:

1. Codul VBA funcționează numai atunci când utilizați Outlook ca program de e-mail.

2. Dacă datele introduse în celula D7 sunt o valoare text, va apărea și fereastra de e-mail.


Trimiteți ușor e-mail prin Outlook pe baza câmpurilor listei de discuții create în Excel:

Platforma Trimite emailuri utilitatea Kutools pentru Excel ajută utilizatorii să trimită e-mailuri prin Outlook pe baza listei de corespondență create în Excel.
Descărcați și încercați acum! (Traseu gratuit de 30 de zile)


Legate de articole:


Cele mai bune instrumente de productivitate Office

Kutools pentru Excel vă rezolvă majoritatea problemelor și vă crește productivitatea cu 80%

  • reutilizarea: Introduceți rapid formule complexe, diagrame și orice ai folosit anterior; Criptați celulele cu parola; Creați o listă de corespondență și trimiteți e-mailuri ...
  • Super Formula Bar (editați cu ușurință mai multe linii de text și formulă); Layout de citire (citiți și editați cu ușurință un număr mare de celule); Lipiți la interval filtrat...
  • Merge celule / rânduri / coloane fără a pierde date; Conținut de celule divizate; Combinați rânduri / coloane duplicate... Prevenirea celulelor duplicate; Comparați gamele...
  • Selectați Duplicat sau Unic Rânduri; Selectați Rânduri goale (toate celulele sunt goale); Super Find și Fuzzy Find în multe cărți de lucru; Selectare aleatorie ...
  • Copie exactă Mai multe celule fără modificarea referinței formulelor; Creați automat referințe la foi multiple; Introduceți gloanțe, Casete de selectare și multe altele ...
  • Extrageți textul, Adăugați text, eliminați după poziție, Eliminați spațiul; Creați și imprimați subtotaluri de paginare; Convertiți conținutul dintre celule și comentarii...
  • Super Filtru (salvați și aplicați scheme de filtrare altor foi); Sortare avansată după lună / săptămână / zi, frecvență și multe altele; Filtru special cu bold, italic ...
  • Combinați cărți de lucru și foi de lucru; Merge Tables pe baza coloanelor cheie; Împărțiți datele în mai multe foi; Conversia în loturi xls, xlsx și PDF...
  • Peste 300 de funcții puternice. Suportă Office / Excel 2007-2019 și 365. Suportă toate limbile. Implementare ușoară în întreprindere sau organizație. Funcții complete de încercare gratuită de 30 de zile. Garanție de restituire a banilor de 60 de zile.
fila kte 201905

Fila Office aduce interfața cu file în Office și vă face munca mult mai ușoară

  • Activați editarea și citirea cu file în Word, Excel, PowerPoint, Publisher, Access, Visio și Project.
  • Deschideți și creați mai multe documente în filele noi ale aceleiași ferestre, mai degrabă decât în ​​ferestrele noi.
  • Vă crește productivitatea cu 50% și reduce sute de clicuri de mouse în fiecare zi!
fundul officetab
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.
    Sunkit Shah · 18 days ago
    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.
    JGentry · 1 months ago

    I was wanting to include the "target text" or cell value in the email body. Is there a way to do that? For Example, If my target value to initiate the email is "test", how can I add it to the email body to say "test, this is a automated message"?

  • To post as a guest, your comment is unpublished.
    jthom2885 · 2 months ago
    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.
    DavidD · 4 months ago
    Hi, I am stuck with a piece of Code. I have combined a few comments below but can't get it to work
    I have added the xtarget part of the code in the Mail_small_text_Outlook to select a specific cell to be included as subject
    As a result, nothing works anymore. Could someone help please

    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("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.
    Yolandivdberg@gmail.com · 5 months ago
    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.
    Corben · 6 months ago
    @crystal Thank you for your response. This helped out.
  • To post as a guest, your comment is unpublished.
    crystal · 6 months ago
    @Corben Baxter Hi,
    Supposing cell D7 is the email trigger, you just need to include this line Range("D7") & vbNewLine & _ in the xMailBody line of the code as follows:

    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.
    Alicia · 6 months ago
    hello
    is there a way to have the value be percentage instead of numeric?
  • To post as a guest, your comment is unpublished.
    Brandon · 6 months ago
    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.
    Corben Baxter · 6 months ago
    @crystal Hi Crystal,

    When targeting a range of cells... how do you get the automated email to call out "identify" the particular cell that generated the email. I am working on a usage based forklift PM spreadsheet that changes column E to read PM NEEDED after 300hrs. We currently have 27 forklifts (cells E3;E49), your code has worked for me in triggering the email but it would be ideal for the email to identify which cell was the email trigger.
  • To post as a guest, your comment is unpublished.
    crystal · 7 months ago
    @reeti jaswal Good day,
    The method in below article may do you a favor. Please have a look:
    How To Send Email If Due Date Has Been Met In Excel?
  • To post as a guest, your comment is unpublished.
    reeti jaswal · 7 months ago
    hello
    i want to send automatic emails when due date come to the concern departments.
    i have to apply this to 3 or 4 columns
    can you please send me code

  • To post as a guest, your comment is unpublished.
    Deepika · 7 months ago
    @Janelle Hi crystal,

    I have below requirement , My excel sheet has below columns Query,reported by,Answer,Answered by.So whenever new row has been added/Query or Answer column updated email should be triggered to many people automatically after saving that excelsheet.In that mail body- modified rows column values should display as Query was reported by that user and Query was answered by that column value. please help me to achieve this.
  • To post as a guest, your comment is unpublished.
    crystal · 7 months ago
    @Thais 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.
    Thais · 7 months ago
    @crystal
    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.
    crystal · 7 months ago
    @Ckey1990 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.
    Ckey1990 · 7 months ago
    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, C7

    ie D25 is filled in so email the contents of A25, B25, C25

    Thanks
  • To post as a guest, your comment is unpublished.
    crystal · 7 months ago
    @Saybier@gmail.com 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.
    crystal · 7 months ago
    @Thais 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.
    Mladen · 8 months ago
    @crystal Thanks! It works.
  • To post as a guest, your comment is unpublished.
    Tyson Nold · 8 months ago
    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.
    Saybier@gmail.com · 8 months ago
    @crystal 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.
    Saybier@gmail.com · 8 months ago
    @crystal 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.
    Saybier@gmail.com · 8 months ago
    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.
    Thais · 8 months ago
    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.
    crystal · 8 months ago
    @Nicolas Molina Hi Nicolas Molina,
    Maybe the code in this tutorial can help you solve the problem:
    How To Send Email If Due Date Has Been Met In Excel?
    https://www.extendoffice.com/documents/excel/4664-excel-send-email-if-due-date-has-been-met.html

  • To post as a guest, your comment is unpublished.
    crystal · 8 months ago
    @Mladen 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.
    Kyle · 8 months ago
    @Kyle 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.
    Nicolas Molina · 8 months ago
    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.
    Kyle · 8 months ago
    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.
    Mladen · 8 months ago
    @crystal 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.
    Mladen · 8 months ago
    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.
    shondap · 8 months ago
    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.
    Mike · 8 months ago
    @crystal I'm not Tyson, but found it helpful (along with the whole tutorial). Thank you!
  • To post as a guest, your comment is unpublished.
    Shonda · 8 months ago
    @crystal What if there are two options in the drop down list Update and Complete? How would the code look? What if each had its own email that would to be sent based on the action?
  • To post as a guest, your comment is unpublished.
    fari · 8 months ago
    hi there
    i have a table in excel file
    i need to email it row by row
    can you help me?
  • To post as a guest, your comment is unpublished.
    crystal · 9 months ago
    @Tyson nold 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.
    Tyson nold · 9 months ago
    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.
    Guru · 9 months ago
    @crystal 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.
  • To post as a guest, your comment is unpublished.
    crystal · 10 months ago
    @Brittany 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.
    Gary · 10 months ago
    Hi, I am using the above code to send auto-generated emails when a cell from range G4:G999, how could I add the value(text) from the adjacent cell in range A4:A999 to the xMailBody on the generated email?
    Many thanks,
    G
  • To post as a guest, your comment is unpublished.
    Brittany · 10 months ago
    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.
    dave · 10 months ago
    Hi
    I am trying to do this type of automatic email button a true or false question true than the form does nothing but false then the form to automatically email out
    Can you help ??
  • To post as a guest, your comment is unpublished.
    crystal · 10 months ago
    @thumsri@gmail.com 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.
    crystal · 10 months ago
    @darkgyft 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.
    darkgyft · 1 years ago
    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.
    thumsri@gmail.com · 1 years ago
    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.
    Stephanie · 1 years ago
    Hi All,
    I'm trying to connect all these actions by clicking a button instead of running it each time. Does anybody know how to do this?
  • To post as a guest, your comment is unpublished.
    Bob · 1 years ago
    Hi! How can I send the e-mails without accepting them at outlook. And they sand automatically without knowing.
  • To post as a guest, your comment is unpublished.
    lynsey · 1 years ago
    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.