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

or

Wie sende ich automatisch E-Mails basierend auf dem Zellenwert in Excel?

Angenommen, Sie möchten eine E-Mail über Outlook an einen bestimmten Empfänger senden, basierend auf einem angegebenen Zellenwert in Excel. Wenn beispielsweise der Wert von Zelle D7 in einem Arbeitsblatt größer als 200 ist, wird automatisch eine E-Mail erstellt. In diesem Artikel wird eine VBA-Methode vorgestellt, mit der Sie dieses Problem schnell lösen können.

Senden Sie automatisch E-Mails basierend auf dem Zellenwert mit VBA-Code


Senden Sie automatisch E-Mails basierend auf dem Zellenwert mit VBA-Code

Bitte gehen Sie wie folgt vor, um eine E-Mail basierend auf dem Zellenwert in Excel zu senden.

1. Im Arbeitsblatt müssen Sie E-Mails basierend auf ihrem Zellenwert senden (hier steht die Zelle D7), mit der rechten Maustaste auf die Registerkarte Blatt klicken und auswählen Code anzeigen aus dem Kontextmenü. Siehe Screenshot:

2. Beim Auftauchen Microsoft Visual Basic für Applikationen Fenster, bitte kopieren Sie den folgenden VBA-Code und fügen Sie ihn in das Blattcode-Fenster ein.

VBA-Code: Senden Sie E-Mails über Outlook basierend auf dem Zellenwert in 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

Notes:

1. Im VBA-Code D7 . Wert> 200 sind die Zelle und der Zellenwert, auf deren Grundlage Sie E-Mails senden.

2. Bitte ändern Sie den E-Mail-Text nach Bedarf xMailBody Zeile im Code.

3. Ersetzen Sie die E-Mail-Adresse durch die E-Mail-Adresse des Empfängers .To = "E-Mail-Adresse".

4. Geben Sie die Cc- und Bcc-Empfänger nach Bedarf an .CC = "" . Bcc = "" .

5. Ändern Sie abschließend den Betreff der E-Mail .Subject = "Send by Cell Value Test".

3. Drücken Sie die Taste Andere + Q Tasten zusammen, um die zu schließen Microsoft Visual Basic für Applikationen Fenster.

Wenn der in Zelle D7 eingegebene Wert von nun an größer als 200 ist, wird in Outlook automatisch eine E-Mail mit den angegebenen Empfängern und dem angegebenen Text erstellt. Sie können auf klicken senden Schaltfläche, um diese E-Mail zu senden. Siehe Screenshot:

Notes:

1. Der VBA-Code funktioniert nur, wenn Sie Outlook als E-Mail-Programm verwenden.

2. Wenn die in Zelle D7 eingegebenen Daten ein Textwert sind, wird auch das E-Mail-Fenster geöffnet.


Senden Sie E-Mails einfach über Outlook basierend auf den Feldern der in Excel erstellten Mailingliste:

Das E-Mails senden Nutzen von Kutools for Excel Hilft Benutzern beim Senden von E-Mails über Outlook basierend auf der in Excel erstellten Mailingliste.
Laden Sie es jetzt herunter und probieren Sie es aus! (30 Tage kostenloser Trail)


In Verbindung stehende Artikel:


Die besten Tools für die Office-Produktivität

Kutools for Excel löst die meisten Ihrer Probleme und erhöht Ihre Produktivität um 80%

  • Wiederverwendung: Schnell einfügen komplexe Formeln, Diagramme und alles, was du vorher benutzt hast; Zellen verschlüsseln mit Passwort; Mailingliste erstellen und E-Mails senden ...
  • Super Formula Bar (leicht mehrere Textzeilen und Formeln bearbeiten); Layout lesen (leichtes Lesen und Bearbeiten einer großen Anzahl von Zellen); In gefilterten Bereich einfügen...
  • Zellen / Zeilen / Spalten zusammenführen ohne Daten zu verlieren; Inhalt geteilter Zellen; Kombinieren Sie doppelte Zeilen / Spalten... doppelte Zellen verhindern; Bereiche vergleichen...
  • Wählen Sie Duplizieren oder Eindeutig Reihen; Wählen Sie Leere Zeilen (alle Zellen sind leer); Super Find und Fuzzy Find in vielen Arbeitsmappen; Zufällige Auswahl ...
  • Exakte Kopie Mehrere Zellen ohne Änderung der Formelreferenz; Referenzen automatisch erstellen zu mehreren Blättern; Aufzählungszeichen einfügen, Kontrollkästchen und mehr ...
  • Text extrahieren, Text hinzufügen, Nach Position entfernen, Leerzeichen entfernen;; Paging-Zwischensummen erstellen und drucken; Inhalt und Kommentare zwischen Zellen konvertieren...
  • Superfilter (Speichern und Anwenden von Filterschemata auf andere Blätter); Erweiterte Sortierung nach Monat / Woche / Tag, Häufigkeit und mehr; Spezialfilter fett, kursiv ...
  • Kombinieren Sie Arbeitsmappen und Arbeitsblätter;; Tabellen basierend auf Schlüsselspalten zusammenführen; Daten in mehrere Blätter aufteilen; Batch-Konvertierung von xls, xlsx und PDF...
  • Mehr als 300 leistungsstarke Funktionen. Unterstützt Office / Excel 2007-2019 und 365. Unterstützt alle Sprachen. Einfache Bereitstellung in Ihrem Unternehmen oder Ihrer Organisation. Vollständige Funktionen 30 Tage kostenlose Testversion. 60 Tage Geld-zurück-Garantie.
kte tab 201905

Office Tab Bringt die Oberfläche mit Registerkarten in Office und erleichtert Ihnen die Arbeit erheblich

  • Aktivieren Sie das Bearbeiten und Lesen von Registerkarten in Word, Excel und PowerPoint, Publisher, Access, Visio und Project.
  • Öffnen und erstellen Sie mehrere Dokumente in neuen Registerkarten desselben Fensters und nicht in neuen Fenstern.
  • Erhöht Ihre Produktivität um 50 % und reduziert jeden Tag Hunderte von Mausklicks für Sie!
officetab unten
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.
    MC · 3 years ago
    Hi

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

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

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

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

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

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

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

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

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

        This replaces the following code:

        Sub email()

        Dim xRg As Range

        Dim xRgEach As Range

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

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


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

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

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

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

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

    Dim xRg As Range

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

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

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

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

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


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

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

        End Sub


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

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

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


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

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