انتقل إلى المحتوى الرئيسي

كيفية إرسال بريد إلكتروني تلقائيًا بناءً على قيمة الخلية في Excel؟

لنفترض أنك تريد إرسال بريد إلكتروني عبر Outlook إلى مستلم معين بناءً على قيمة خلية محددة في Excel. على سبيل المثال ، عندما تكون قيمة الخلية D7 في ورقة العمل أكبر من 200 ، يتم إنشاء بريد إلكتروني تلقائيًا. تقدم هذه المقالة طريقة VBA لك لحل هذه المشكلة بسرعة.

إرسال بريد إلكتروني تلقائيًا استنادًا إلى قيمة الخلية باستخدام رمز VBA


إرسال بريد إلكتروني تلقائيًا استنادًا إلى قيمة الخلية باستخدام رمز VBA

يرجى القيام بما يلي لإرسال بريد إلكتروني بناءً على قيمة الخلية في Excel.

1. في ورقة العمل ، تحتاج إلى إرسال بريد إلكتروني بناءً على قيمة الخلية الخاصة بها (تشير هنا الخلية D7) ، انقر بزر الماوس الأيمن فوق علامة تبويب الورقة ، وحدد عرض الرمز من قائمة السياق. انظر لقطة الشاشة:

2. في ظهرت ميكروسوفت فيسوال باسيك للتطبيقات نافذة ، يرجى نسخ ولصق رمز فبا أدناه في نافذة كود الورقة.

كود VBA: أرسل بريدًا إلكترونيًا عبر Outlook استنادًا إلى قيمة الخلية في Excel

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

ملاحظة:

1). في كود VBA ، D7 و القيمة> 200 هي الخلية وقيمة الخلية التي سترسل البريد الإلكتروني بناءً عليها.
2). يرجى تغيير نص البريد الإلكتروني كما تريد xMailBody سطر في الكود.
3). استبدل عنوان البريد الإلكتروني بعنوان البريد الإلكتروني للمستلم في السطر .To = "عنوان البريد الإلكتروني".
4). وحدد مستلمي "نسخة إلى" و "نسخة مخفية الوجهة" كما تريد .CC = "" و نسخة مخفية الوجهة = "" أقسام.
5). أخيرًا قم بتغيير موضوع البريد الإلكتروني في السطر .Subject = "إرسال عن طريق اختبار قيمة الخلية".

3. اضغط على قديم + Q مفاتيح معًا لإغلاق ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

من الآن فصاعدًا ، عندما تكون القيمة التي تدخلها في الخلية D7 أكبر من 200 ، سيتم إنشاء بريد إلكتروني بالمستلمين المحددين والجسم تلقائيًا في Outlook. يمكنك النقر فوق أرسل زر لإرسال هذا البريد الإلكتروني. انظر لقطة الشاشة:

ملاحظة:

1. يعمل رمز VBA فقط عند استخدام Outlook كبرنامج بريد إلكتروني.

2. إذا كانت البيانات المدخلة في الخلية D7 عبارة عن قيمة نصية ، فسيتم أيضًا ظهور نافذة البريد الإلكتروني.


أرسل بريدًا إلكترونيًا بسهولة عبر Outlook استنادًا إلى حقول القائمة البريدية التي تم إنشاؤها في Excel:

إرسال رسائل البريد الإلكتروني فائدة كوتولس ل إكسيل يساعد المستخدمين على إرسال البريد الإلكتروني عبر Outlook بناءً على قائمة بريدية تم إنشاؤها في Excel.
قم بتنزيله وجربه الآن! (تجربة مجانية لمدة 30 يومًا)


مقالات ذات صلة:

أفضل أدوات إنتاجية المكتب

🤖 مساعد Kutools AI: إحداث ثورة في تحليل البيانات على أساس: التنفيذ الذكي   |  إنشاء التعليمات البرمجية  |  إنشاء صيغ مخصصة  |  تحليل البيانات وإنشاء الرسوم البيانية  |  استدعاء وظائف Kutools...
الميزات الشعبية: البحث عن التكرارات أو تمييزها أو تحديدها   |  حذف الصفوف الفارغة   |  دمج الأعمدة أو الخلايا دون فقدان البيانات   |   جولة بدون صيغة 
سوبر بحث: معايير متعددة VLookup    VLookup ذات القيمة المتعددة  |   VLookup عبر أوراق متعددة   |   بحث غامض ....
قائمة منسدلة متقدمة: إنشاء القائمة المنسدلة بسرعة   |  القائمة المنسدلة التابعة   |  قائمة منسدلة متعددة التحديد ....
مدير العمود: إضافة عدد محدد من الأعمدة  |  نقل الأعمدة  |  تبديل حالة رؤية الأعمدة المخفية  |  مقارنة النطاقات والأعمدة 
الميزات المميزة: التركيز على الشبكة   |  عرض تصميم   |   شريط الفورمولا الكبير    مدير المصنفات والأوراق   |  مكتبة الموارد (النص السيارات)   |  منتقي التاريخ   |  اجمع أوراق العمل   |  تشفير/فك تشفير الخلايا    إرسال رسائل البريد الإلكتروني عن طريق القائمة   |  سوبر تصفية   |   مرشح خاص (تصفية غامق / مائل / يتوسطه خط ...) ...
أفضل 15 مجموعة أدوات12 نص الأدوات (إضافة نص, إزالة الأحرف، ...)   |   +50 رسم الأنواع (مخطط جانت، ...)   |   40+ عملي الصيغ (احسب العمر على أساس تاريخ الميلاد، ...)   |   19 إدخال الأدوات (أدخل رمز الاستجابة السريعة, إدراج صورة من المسار، ...)   |   12 تحويل الأدوات (أرقام إلى كلمات, نتيجة تحويل عملة، ...)   |   7 دمج وتقسيم الأدوات (الجمع بين الصفوف المتقدمة, تقسيم الخلايا، ...)   |   ... و اكثر

عزز مهاراتك في Excel باستخدام Kutools for Excel، واختبر كفاءة لم يسبق لها مثيل. يقدم Kutools for Excel أكثر من 300 ميزة متقدمة لتعزيز الإنتاجية وتوفير الوقت.  انقر هنا للحصول على الميزة التي تحتاجها أكثر...

الوصف


يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
Comments (318)
Rated 5 out of 5 · 1 ratings
This comment was minimized by the moderator on the site
Hello cristal, i need u help, im trying to use this code in a board, so i need that when for example E2 < D2 send a message with the information in C2, and this whit E3,D3,C3........ E4,D4,C4 etc.
This comment was minimized by the moderator on the site
Hi Ernesto,

The following VBA code may help. Please give it a try. Thank you.
Note: If a change is detected and the new value in an "E" row cell is less than its corresponding "D" row cell, it triggers the Mail_small_Text_Outlook subroutine. The content from the corresponding "C" row cell is passed into this subroutine and included in the email body.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by extendoffice 20230315
    Dim xRg As Range
    Dim cell As Range

    ' Only trigger for changes in column E
    Set xRg = Intersect(Me.Range("E:E"), Target)

    If Not xRg Is Nothing Then
        Application.EnableEvents = False ' Prevent further event triggers
        On Error GoTo Finalize ' Ensure events are re-enabled in case of error

        For Each cell In xRg
            ' Check if the cell in column E is less than the corresponding cell in column D
            If IsNumeric(cell.Value) And IsNumeric(cell.Offset(0, -1).Value) Then
                If cell.Value < cell.Offset(0, -1).Value Then
                    ' Call the mail subroutine, passing the content of the corresponding cell in column C
                    Call Mail_small_Text_Outlook(cell.Offset(0, -2).Value)
                End If
            End If
        Next cell

Finalize:
        Application.EnableEvents = True ' Re-enable events
        On Error GoTo 0 ' Clear error handling
    End If
End Sub

Sub Mail_small_Text_Outlook(ByVal mailContent As String)
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String

    ' Create the Outlook objects
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)

    ' Customize your email body with the content from column C
    xMailBody = "Hi there" & vbNewLine & vbNewLine & mailContent

    ' Customize the email details
    With xOutMail
        .To = "Email Address" ' Add your recipient here
        .CC = ""
        .BCC = ""
        .Subject = "Send by cell value test"
        .Body = xMailBody
        .Display   ' or use .Send to send the email directly
    End With

    ' Cleanup
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub
This comment was minimized by the moderator on the site
Dear, the code works perfectly, but I am still looking to expand it a bit for my project. I am creating a project dashboard where I track the progress of the projects. The end time of the project will then be listed in row G:G and if, for example, he still has 2 weeks before the project must be completed, he must send an email to the project owner who is responsible there, this project owner will then be in, for example, row "I" but each project is placed in a new column and therefore always has a different project owner. How can I process this so that VBA automatically sends me an email to the owner in I7 when the date is reached in BV G7?
And with G8 then send to the owner who is in I8? And so on of course.
Hopefully you can help me.
This comment was minimized by the moderator on the site
Hi Crystal,

This is great. Thank you! Not sure if you're still monitoring this I'm but wondering if you could advise on how to make some modifications to this code. I was able to tweak it to look at a range of cells rather than just a specific cell like in your original example (In my case D4:D41) but what if I want to look for changes made above a certain value in multiple columns? In my case I'd like to look for values >8 in D4:D41 as well as >13 in E4:E41. Also, is there a way to hold off on sending the email until multiple changes have been made instead of immediately after a cell in Column D (or E) is raised above the threshold? I know that by using the 'Developer' tab on the ribbon I can create a "Send Email" button but what tweaks to the code would need to be made so that it doesn't send until that button is clicked?

As a cherry on top, is there a way to call out the corresponding row data from column A in the body of the email? The sheet I'm working with has various room numbers in Column A and target values in Columns D & E. Is there a way to structure it so that if the value in, say, D11 goes above the threshold the email will say "Room # (A11)" needs attention and if E25 goes above its threshold the email will say Room # (E25) needs attention? If that makes sense
This comment was minimized by the moderator on the site
Hi, i have created and excel sheet that uses dates of the year ( todays date to next years expiry date ) the cell i have crated is a column consisting of 60+ candidates. The cell changes value until it reaches the expire date. I would like to use this column dates to trigger an automated email with an attachment of the excel sheet when the cell value reaches a certain amount before the expiry date.
I want to use this as an alert so that i can see which person document will expire.

Please help I've been struggling for a long while...

Thank you!!
This comment was minimized by the moderator on the site
Hi Andries,

Sorry I don't quite understand your question. Would you mind providing a screenshot of your data? Sorry for the inconvenience.
This comment was minimized by the moderator on the site
Hello, I set up the VBA to send an automatic email. Now, when a row with columns A, B, C, D, E, F, G, H, I, J, K, L, M, N is filled in, an email is automatically created and sent shall be. As an example, line 10 has now been filled in from A to N, as soon as this has happened this data should be sent in the email.
This should then be possible up to line 5000.
Can you help me with the problem?
This comment was minimized by the moderator on the site
Hi Michael Schlegel,

To modify the VBA code to automatically create an email when columns A to N in a row are filled out, follow these steps:
In the Worksheet_Change event, monitor the range A:N up to the 5000th row.
Check if all cells in the columns A to N of the changed row contain values.
If all cells in that row have values, trigger the email displaying function.


Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20230817
    Dim EntireRow As Range
    Dim IsRowFilled As Boolean
    Dim i As Integer
    
    ' If multiple cells are changed simultaneously, exit
    If Target.Cells.CountLarge > 1 Then Exit Sub

    ' Only monitor the range A10:N5000
    If Not Intersect(Target, Range("A10:N5000")) Is Nothing Then
        ' Check if the entire row from A to N has values
        Set EntireRow = Range("A" & Target.Row & ":N" & Target.Row)
        IsRowFilled = True
        For Each cell In EntireRow
            If IsEmpty(cell.Value) Then
                IsRowFilled = False
                Exit For
            End If
        Next cell
        ' If the row is filled, send the email
        If IsRowFilled Then
            Call Mail_small_Text_Outlook(EntireRow)
        End If
    End If
End Sub

Sub Mail_small_Text_Outlook(RowData As Range)
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)

    ' Modify this line to format the email body as per your requirements
    xMailBody = "The following data has been entered:" & vbNewLine & Join(Application.Transpose(Application.Transpose(RowData.Value)), " ")

    On Error Resume Next
    With xOutMail
        .To = "Email Address"
        .CC = ""
        .BCC = ""
        .Subject = "New row filled out in Excel"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub
This comment was minimized by the moderator on the site
Hi

Thank you so much for posting this VBA Code and instructions. Your code is most definitely continuing to help us rookies! Thank you 🥰! When I found it I felt like I'd won in the Excel VBA game. However, I am stuck on something so I'm hoping you can help. If not, please kindly point me in the right direction. I'm new to VBA, self-taught as much as possible, and only have very basic understanding of most of the commands.

Your code has helped me answer the question of "how to I send to an email address without having to manually enter the address in the code". But, now I'm struggling with "how to route through a list of addresses based on a cell condition". Meaning, I have a protected form with 28 data elements, 21 lines of data, and 5 approvers must approve the data before any action can be taken (data added to SAP). Signature lines have been added to the form for electronic approvals (was initially trying to use the Signature line email addresses but failed to find help on that issue).

Since I was not able to find how to use the Signature line email addresses, I created an email table with email addresses in the range M37:M42 and a Sent indicator in the range O37:O42.

Workflow: once the Originator of the form has completed entering the data, he/she clicks the "Send to Next Approver" button. The code for the button is to loop through checking that M & target row is not blank, check that the Sent indicator in O & target row is blank, then generate an email to the approver and set Sent indicator for that row to "X". The Originator (M37) will be the last to receive a final email showing all approvals. At the end of routing, all Sent indicator fields should have an "X" and the form is digitally signed and protected.

I'm getting a compile error : "Procedure declaration does not match description of event or procedure having the same name". I think it is something very simple look right at me, but I cannot see to find it. Thank you in advance.

Here's my code:

Dim xRg As Range
Private Sub CommandButton1_Click(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("O38:O42"), Target)
If xRg Is Nothing Then Exit Sub
If Target.Value = " " Then
Call Mail_small_Text_Outlook(Target)
Set Target.Value = "X"
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xRgTo As Range
Dim xOutlookObj As Object
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
On Error Resume Next

Set xRgTo = Application.Range("M" & Target.Row)
If xRgTo Is Nothing Then Exit Sub

ThisWorkbook.Worksheets("List Form").Unprotect ("9999")
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)

xMailBody = "Your review/approval is needed on a Material Master form." & vbNewLine & vbNewLine & _
"Click the hyperlink or copy/paste the file name in a browser to open form." & vbNewLine & vbNewLine & _
Range("BW1") & vbNewLine & _
" "
On Error Resume Next
With xOutMail
.To = xRgTo
' .CC = ""
' .BCC = ""
.Subject = "Material Master / BOM Review & Approval"
.Body = xMailBody
' .Attachments.Add ActiveWorkbook.FullName
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
ActiveSheet.Protect ("9999"), DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowInsertingHyperlinks:=True, AllowSorting:=True, AllowFiltering:=True
' ThisWorkbook.Worksheets("List Form").Protect ("9999")
End Sub
This comment was minimized by the moderator on the site
Hi

Thank you so much for posting this VBA Code and instructions. Your code is most definitely continuing to help us rookies! Thank you 🥰! When I found it I felt like I'd won in the Excel VBA game. However, I am stuck on something so I'm hoping you can help. If not, please kindly point me in the right direction. I'm new to VBA, self-taught as much as possible, and only have very basic understanding of most of the commands.

Your code has helped me answer the question of "how to I send to an email address without having to manually enter the address in the code". But, now I'm struggling with "how to route through a list of addresses based on a cell condition". Meaning, I have a protected form with 28 data elements, 21 lines of data, and 5 approvers must approve the data before any action can be taken (data added to SAP). Signature lines have been added to the form for electronic approvals (was initially trying to use the Signature line email addresses but failed to find help on that issue).

Since I was not able to find how to use the Signature line email addresses, I created an email table with email addresses in the range M37:M42 and a Sent indicator in the range O37:O42.

Workflow: once the Originator of the form has completed entering the data, he/she clicks the "Send to Next Approver" button. The code for the button is to loop through checking that M & target row is not blank, check that the Sent indicator in O & target row is blank, then generate an email to the approver and set Sent indicator for that row to "X". The Originator (M37) will be the last to receive a final email showing all approvals. At the end of routing, all Sent indicator fields should have an "X" and the form is digitally signed and protected.

I'm getting a compile error : "Procedure declaration does not match description of event or procedure having the same name". I think it is something very simple look right at me, but I cannot see to find it. Thank you in advance.

Here's my code:

Dim xRg As Range
Private Sub CommandButton1_Click(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("O38:O42"), Target)
If xRg Is Nothing Then Exit Sub
If Target.Value = " " Then
Call Mail_small_Text_Outlook(Target)
Set Target.Value = "X"
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xRgTo As Range
Dim xOutlookObj As Object
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
On Error Resume Next

Set xRgTo = Application.Range("M" & Target.Row)
If xRgTo Is Nothing Then Exit Sub

ThisWorkbook.Worksheets("List Form").Unprotect ("9999")
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)

xMailBody = "Your review/approval is needed on a Material Master form." & vbNewLine & vbNewLine & _
"Click the hyperlink or copy/paste the file name in a browser to open form." & vbNewLine & vbNewLine & _
Range("BW1") & vbNewLine & _
" "
On Error Resume Next
With xOutMail
.To = xRgTo
' .CC = ""
' .BCC = ""
.Subject = "Material Master / BOM Review & Approval"
.Body = xMailBody
' .Attachments.Add ActiveWorkbook.FullName
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
ActiveSheet.Protect ("9999"), DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowInsertingHyperlinks:=True, AllowSorting:=True, AllowFiltering:=True
' ThisWorkbook.Worksheets("List Form").Protect ("9999")
End Sub
This comment was minimized by the moderator on the site
Wie schreibe ich den Code um, wenn je nachdem welche Zelle ausgefüllt wird eine Mail an eine bestimmte Person gehen soll.

Beispielsweise wird Zelle A1 ausgefüllt, dann geht automatisch ein Mail Fenster auf mit Mail Adresse von Person A.
Wenn Zelle B1 ausgefüllt wird, dann geht automatisch ein Mail Fenster auf mit Mail Adresse von Person B
... etc.

Ich habe es mit der Funktion Case versucht, jedoch leider nicht geschafft.
Besten Dank für die Rückmeldung.
This comment was minimized by the moderator on the site
Dear

code run when insect value in D7 but can't run when D7 = result ( X+Y)
How to ?
Thanks your
This comment was minimized by the moderator on the site
Hi I am looking for a code that when a cell changes YELLOW, I want an email to send automatically to that person and when the cell changes RED another e-mail to be sent to them.

The cells contain expiry dates of mandatory training and are:
- GREEN when in date,
- YELLOW when they have 29 days before they are out of date AND
- RED when they are a day over the date that their training expires.

The e-mails are to prompt them to book onto a course when they are YELLOW (almost out of date) and to input there new expiry date when they get an email when it turns RED.

Hope that all makes sense.

Formula for it to turn green: GREATER THAN =NOW()+30
Yellow: BETWEEN =NOW() =NOW()+29
Red: LESS THAN =NOW()-1

Thank you in advance, Alyssa
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations