Skip i'r prif gynnwys

Sut i anfon e-bost yn awtomatig yn seiliedig ar werth celloedd yn Excel?

Gan dybio eich bod am anfon e-bost trwy Outlook at dderbynnydd penodol yn seiliedig ar werth celloedd penodol yn Excel. Er enghraifft, pan fydd gwerth cell D7 mewn taflen waith yn fwy na 200, yna crëir e-bost yn awtomatig. Mae'r erthygl hon yn cyflwyno dull VBA i chi ddatrys y mater hwn yn gyflym.

Anfon e-bost yn awtomatig yn seiliedig ar werth celloedd gyda chod VBA


Anfon e-bost yn awtomatig yn seiliedig ar werth celloedd gyda chod VBA

Gwnewch fel a ganlyn i anfon e-bost yn seiliedig ar werth celloedd yn Excel.

1. Yn y daflen waith mae angen i chi anfon e-bost yn seiliedig ar ei werth cell (yma dywed y gell D7), de-gliciwch y tab dalen, a dewis Gweld y Cod o'r ddewislen cyd-destun. Gweler y screenshot:

2. Yn y popping up Microsoft Visual Basic ar gyfer Ceisiadau ffenestr, copïwch a gludwch y cod VBA isod i mewn i'r ffenestr cod dalen.

Cod VBA: Anfon e-bost trwy Outlook yn seiliedig ar werth celloedd yn 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

Nodiadau:

1). Yn y cod VBA, D7 ac gwerth> 200 yw'r gwerth celloedd a chell y byddwch yn anfon e-bost yn seiliedig arno.
2). Newidiwch y corff e-bost yn ôl yr angen xMailCorff llinell yn y cod.
3). Amnewid y Cyfeiriad E-bost gyda chyfeiriad e-bost y derbynnydd yn unol .To = "Cyfeiriad E-bost".
4). A nodwch y derbynwyr Cc a Bcc yn ôl yr angen .CC = “” ac Bcc = “” adran.
5). Yn olaf newid y pwnc e-bost yn unol .Subject = "anfon trwy brawf gwerth celloedd".

3. Gwasgwch y Alt + Q allweddi gyda'i gilydd i gau'r Microsoft Visual Basic ar gyfer Ceisiadau ffenestr.

O hyn ymlaen, pan fydd y gwerth rydych chi'n ei nodi yng nghell D7 yn fwy na 200, bydd e-bost gyda derbynwyr a chorff penodol yn cael ei greu yn awtomatig yn Outlook. Gallwch glicio ar y anfon botwm i anfon yr e-bost hwn. Gweler y screenshot:

Nodiadau:

1. Dim ond pan fyddwch chi'n defnyddio Outlook fel eich rhaglen e-bost y mae'r cod VBA yn gweithio.

2. Os yw'r data a gofnodwyd yng nghell D7 yn werth testun, bydd y ffenestr e-bost yn cael ei popio allan hefyd.


Yn hawdd anfon e-bost trwy Outlook yn seiliedig ar feysydd rhestr bostio a grëwyd yn Excel:

Mae Anfon E-byst cyfleustodau Kutools for Excel yn helpu defnyddwyr i anfon e-bost trwy Outlook yn seiliedig ar restr bostio wedi'i chreu yn Excel.
Dadlwythwch a rhowch gynnig arni nawr! (30- llwybr diwrnod am ddim)


Erthyglau cysylltiedig:

Offer Cynhyrchiant Swyddfa Gorau

Nodweddion Poblogaidd: Darganfod, Amlygu neu Adnabod Dyblygiadau   |  Dileu Rhesi Gwag   |  Cyfuno Colofnau neu Gelloedd heb Colli Data   |   Rownd heb Fformiwla ...
Super-edrych: VLookup Meini Prawf Lluosog    VLookup Gwerth Lluosog  |   VLookup Ar Draws Taflenni Lluosog   |   Edrych Niwlog ....
Rhestr gwympo Uwch: Creu Rhestr Gollwng yn Gyflym   |  Rhestr Gollwng Dibynnol   |  Rhestr Gollwng Aml-ddewis ....
Rheolwr Colofn: Ychwanegu Nifer Penodol o Golofnau  |  Symud Colofnau  |  Toglo Statws Gwelededd Colofnau Cudd  |  Cymharwch Ystodau a Cholofnau ...
Nodweddion dan Sylw: Ffocws ar y Grid   |  Golwg Dylunio   |   Bar Fformiwla Mawr    Rheolwr Llyfr Gwaith a Thaflen   |  Llyfrgell Adnoddau (Testun Auto)   |  Dewiswr Dyddiad   |  Cyfuno Taflenni Gwaith   |  Amgryptio/Dadgryptio Celloedd    Anfon E-byst trwy Restr   |  Hidlo Super   |   Hidlo Arbennig (hidlo mewn print trwm/italig/strikethrough...) ...
15 Set Offer Gorau12 Testun offer (Ychwanegu Testun, Dileu Cymeriadau,...)   |   50 + Siart Mathau (Siart Gantt,...)   |   40+ Ymarferol Fformiwlâu (Cyfrifwch oedran yn seiliedig ar ben-blwydd,...)   |   19 mewnosod offer (Mewnosod Cod QR, Mewnosod Llun o'r Llwybr,...)   |   12 Trosi offer (Rhifau i Eiriau, Trosi arian cyfred,...)   |   7 Uno a Hollti offer (Rhesi Cyfuno Uwch, Celloedd Hollt,...)   |   ... a mwy

Supercharge Eich Sgiliau Excel gyda Kutools for Excel, a Phrofiad Effeithlonrwydd Fel Erioed Erioed o'r blaen. Kutools for Excel Yn cynnig dros 300 o nodweddion uwch i hybu cynhyrchiant ac arbed amser.  Cliciwch Yma i Gael Y Nodwedd Sydd Ei Angen Y Mwyaf...

tab kte 201905


Office Tab Yn dod â rhyngwyneb Tabbed i Office, ac yn Gwneud Eich Gwaith yn Haws o lawer

  • Galluogi golygu a darllen tabbed yn Word, Excel, PowerPoint, Cyhoeddwr, Mynediad, Visio a Phrosiect.
  • Agor a chreu dogfennau lluosog mewn tabiau newydd o'r un ffenestr, yn hytrach nag mewn ffenestri newydd.
  • Yn cynyddu eich cynhyrchiant 50%, ac yn lleihau cannoedd o gliciau llygoden i chi bob dydd!
Comments (315)
Rated 5 out of 5 · 1 ratings
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
This comment was minimized by the moderator on the site
Hello Crystal. can you help me please?
I need to do a stock list for tools and I need to send an email to my boss.
But I need to send 1 mail for each cell that is under the target that he want. Can you please help me?
This comment was minimized by the moderator on the site
Hi tiagocanoso0989 Canoso,

Sorry I don't quite understand you mentioned about "with the reference in cell E6". Do you want to reference the value in cell E6 in the email body when sending an email based on the value in F5 (the value is <2)? What about the cell F13, is there any cell need to be referenced in the email body? For clarity, please attach a sample file or a screenshot with your data and desired results.
Or you can see if the VBA code I replied to Bryan Engledow above can help.
This comment was minimized by the moderator on the site
Hello how can I change to do this but for example if cell f5 is <2 send mail to buy the tool with the reference in cell E6
I need to do this for cell f5 <2
Cell f13 <7 and more diferent cells is a stock regulation

Thank-you a lot if you can save me
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