Loncat ke daftar isi utama

Bagaimana cara mengirim email jika sel tertentu diubah di Excel?

Artikel ini berbicara tentang mengirim email melalui Outlook saat sel dalam rentang tertentu dimodifikasi di Excel.

Kirim email jika sel dalam rentang tertentu dimodifikasi dengan kode VBA

Kirim email jika sel dalam rentang tertentu dimodifikasi dengan kode VBA

Jika Anda perlu membuat email baru secara otomatis dengan buku kerja aktif yang dilampirkan saat sel dalam rentang A2:E11 dimodifikasi di lembar kerja tertentu, kode VBA berikut dapat membantu Anda.

1. Di lembar kerja yang Anda perlukan untuk mengirim email berdasarkan sel yang dimodifikasi dalam kisaran tertentu, klik kanan tab lembar dan kemudian klik Lihat kode dari menu konteks. Lihat tangkapan layar:

2. Dalam bermunculan Microsoft Visual Basic untuk Aplikasi jendela, silakan salin dan tempel kode VBA di bawah ini ke jendela Kode.

Kode VBA: Kirim email jika sel dalam kisaran tertentu diubah di Excel

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
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set xRg = Range("A2:E11")
    Set xRgSel = Intersect(Target, xRg)
    ActiveWorkbook.Save
    If Not xRgSel Is Nothing Then
        Set xOutApp = CreateObject("Outlook.Application")
        Set xMailItem = xOutApp.CreateItem(0)
        xMailBody = "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") & "."

        With xMailItem
            .To = "Email Address"
            .Subject = "Worksheet modified in " & ThisWorkbook.FullName
            .Body = xMailBody
            .Attachments.Add (ThisWorkbook.FullName)
            .Display
        End With
        Set xRgSel = Nothing
        Set xOutApp = Nothing
        Set xMailItem = Nothing
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Catatan:

1). Di dalam kode, A2: E11 adalah rentang yang akan Anda gunakan untuk mengirim email.
2). Harap ubah badan email sesuai kebutuhan Anda xMailBody baris dalam kode.
3). Ganti Alamat email dengan alamat email penerima sejalan .To = "Alamat Email".
4). Ubah subjek email sesuai .Subject = "Lembar kerja diubah dalam" & Buku Kerja Ini.FullName.

3. tekan lain + Q tombol secara bersamaan untuk menutup Microsoft Visual Basic untuk Aplikasi jendela.

Mulai sekarang, sel apa pun dalam rentang A2: E11 diubah, email baru akan dibuat dengan lampiran buku kerja yang diperbarui. Dan semua bidang yang ditentukan seperti subjek, penerima, dan badan email akan dicantumkan di email. Silakan kirim email.

Note: Kode VBA hanya berfungsi jika Anda menggunakan Outlook sebagai program email Anda.

Artikel terkait:

Alat Produktivitas Kantor Terbaik

馃 Kutools AI Ajudan: Merevolusi analisis data berdasarkan: Eksekusi Cerdas   |  Hasilkan Kode  |  Buat Rumus Khusus  |  Analisis Data dan Hasilkan Grafik  |  Aktifkan Fungsi Kutools...
Fitur Populer: Temukan, Sorot, atau Identifikasi Duplikat   |  Hapus Baris Kosong   |  Gabungkan Kolom atau Sel tanpa Kehilangan Data   |   Putaran tanpa Formula ...
Pencarian Super: VLookup Beberapa Kriteria  |   VLookup Nilai Berganda  |   VLookup di Beberapa Lembar   |   Pencarian Fuzzy ....
Daftar Drop-down Lanjutan: Buat Daftar Drop Down dengan Cepat   |  Daftar Drop Down yang Bergantung   |  Multi-pilih Drop Down List ....
Manajer Kolom: Tambahkan Jumlah Kolom Tertentu  |  Pindahkan Kolom  |  Alihkan Status Visibilitas Kolom Tersembunyi  |  Bandingkan Rentang & Kolom ...
Fitur Unggulan: Fokus Kisi   |  Tampilan Desain   |   Bar Formula Besar   |  Manajer Buku Kerja & Lembar   |  Perpustakaan Sumberdaya (Teks otomatis)   |  Pemetik tanggal   |  Gabungkan Lembar Kerja   |  Enkripsi/Dekripsi Sel   |  Kirim Email berdasarkan Daftar   |  Filter Super   |   Filter Khusus (filter tebal/miring/coret...) ...
15 Perangkat Teratas:  12 Teks Tools (Tambahkan Teks, Hapus Karakter, ...)   |   50 + Grafik jenis (Gantt Chart, ...)   |   40+ Praktis Rumus (Hitung usia berdasarkan ulang tahun, ...)   |   19 Insersi Tools (Masukkan Kode QR, Sisipkan Gambar dari Jalur, ...)   |   12 Konversi Tools (Angka ke Kata, Konversi Mata Uang, ...)   |   7 Gabungkan & Pisahkan Tools (Lanjutan Gabungkan Baris, Pisahkan Sel, ...)   |   ... dan banyak lagi

Tingkatkan Keterampilan Excel Anda dengan Kutools for Excel, dan Rasakan Efisiensi yang Belum Pernah Ada Sebelumnya. Kutools for Excel Menawarkan Lebih dari 300 Fitur Lanjutan untuk Meningkatkan Produktivitas dan Menghemat Waktu.  Klik Di Sini untuk Mendapatkan Fitur yang Paling Anda Butuhkan...

Deskripsi Produk

Tab Office Membawa antarmuka Tab ke Office, dan Membuat Pekerjaan Anda Jauh Lebih Mudah

  • Aktifkan pengeditan dan pembacaan tab di Word, Excel, PowerPoint, Publisher, Access, Visio, dan Project.
  • Buka dan buat banyak dokumen di tab baru di jendela yang sama, bukan di jendela baru.
  • Meningkatkan produktivitas Anda sebesar 50%, dan mengurangi ratusan klik mouse untuk Anda setiap hari!
Comments (41)
Rated 5 out of 5 路 1 ratings
Ajay_2510
Ajay_2510
This comment was minimized by the moderator on the site
Hi, Please I want the above code with two little changes

1.It should work at workbook level if there is any change in entire workbook or cell it should send mail
2.Code should trigger mail after cell change but on workbook save
Reply
Report
0
0
Ajay_2510
Ajay_2510
This comment was minimized by the moderator on the site
Hi, Please I want the above code with two little changes

1.It should work at workbook level if there is any change in entire workbook or cell it should send mail
2.Code should trigger mail not on cell change but on workbook save
Reply
Report
0
0
crystal
crystal     Ajay_2510
This comment was minimized by the moderator on the site
Hi Ajay_2510,
To achieve your two requirements:

1. Have the event trigger for changes on any worksheet within the workbook.
2. Trigger the event only when saving the workbook.

You'll need to move your code from the Worksheet_Change event in a specific worksheet to the Workbook_BeforeSave event in the ThisWorkbook module.
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/thisworkbook.png?1692238842

Here's the modified code:


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xMailBody As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set xOutApp = CreateObject("Outlook.Application")
    Set xMailItem = xOutApp.CreateItem(0)
    xMailBody = "The workbook '" & ThisWorkbook.FullName & _
                "' was modified on " & Format$(Now, "mm/dd/yyyy") & _
                " at " & Format$(Now, "hh:mm:ss") & " by " & Environ$("username") & "."

    With xMailItem
        .To = "Email Address"
        .Subject = "Workbook modified: " & ThisWorkbook.FullName
        .Body = xMailBody
        .Attachments.Add (ThisWorkbook.FullName)
        .Display   ' Or use .Send to send the email automatically
    End With

    Set xOutApp = Nothing
    Set xMailItem = Nothing

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Reply
Report
1
0
Ajay_2510
Ajay_2510     crystal
This comment was minimized by the moderator on the site
Only 1 issue here ,Otherwise it works great.

1.It triggers mail also if someone opens workbook and saves it (Without making changes)

I want it to trigger mail if changes are made in workbook and saved only in that particular case.
if user is not making changes and just opening and saving the workbook the mail should not shoot.

Thanks for the help, I appreciate it
Reply
Report
0
0
Rated 5 out of 5
Joe
Joe
This comment was minimized by the moderator on the site
Here's another question. If one cell changes, it sends a email. if 3 cells change, it sends 3 emails. How do you stop this so it only sends 1 email when the edits are done?
Reply
0
0
crystal
crystal     Joe
This comment was minimized by the moderator on the site
Hi Joe,
Supposing you specified the range as "A2:E11" in the code. How can I verify when the whole edits are done?
Reply
Report
0
0
Joe
Joe
This comment was minimized by the moderator on the site
I would like to send the email to 5 people. What delineator is used between each email address?
Reply
0
0
crystal
crystal     Joe
This comment was minimized by the moderator on the site
Hi Joe,
Please use a semicolon to separate the email addresses.
Reply
Report
0
0
ychevray
ychevray
This comment was minimized by the moderator on the site
Bonjour et merci pour ce tuto.
J'ai cependant une difficult茅 pour l'application de la plage de recherche.
Dans le code, j'ai demand茅 脿 v茅rifier la plage C2:C4.
Tout fonctionne bien si je modifie C2, C3 ou C4 uniquement. Cela fonctionne aussi si je modifie C2+C3+C4 ou C2+C3 ou C3+C4 mais cela ne fonctionne pas si j'ai un saut dans la plage. Par exemple, si je modifie C2 et C4 sans modifier C3.
Est-ce que quelqu'un pourrait m'aider pour m'indiquer o霉 se trouve mon erreur ?
Merci d'avance.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220921
Dim xAddress As String
Dim xDRg, xRgSel, xRg As Range

xAddress = "C2:C4"
Set xDRg = Range(xAddress)
Set xRgSel = Intersect(Target, xDRg)
On Error GoTo Err1
If Not xRgSel Is Nothing Then
If ThisWorkbook.gChangeRange = "" Then
ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
Else
Set xRg = Range(ThisWorkbook.gChangeRange)
Set xRg = Application.Union(xRg, xRgSel)
ThisWorkbook.gChangeRange = xRg.AddressLocal(False, False, xlA1, True, False)
End If
End If
Exit Sub
Err1:
ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
End Sub


-----

Option Explicit
Public gChangeRange As String
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
'Updated by Extendoffice 20220921
Dim xRgSel, xRg As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String
'On Error Resume Next
On Error GoTo Err1
Set xRg = Range(gChangeRange)
If Not xRg Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xMailBody = "Cher Jean-Marie, " & vbCrLf & vbCrLf & "Dans le fichier : " & ThisWorkbook.FullName & vbCrLf & "La plage de cellules a 茅t茅 modifi茅e :" & xRg.Address(False, False) & vbCrLf & vbCrLf & "Cordialement"
With xMailItem
.To = ""
.Subject = "Donn茅es modifi茅es " & ThisWorkbook.Name
.Body = xMailBody
.Attachments.Add (ThisWorkbook.FullName)
.Display
End With
Set xRgSel = Nothing
Set xOutApp = Nothing
Set xMailItem = Nothing
End If
Err1:
gChangeRange = ""
End Sub
Reply
0
0
Kathryn F
Kathryn F
This comment was minimized by the moderator on the site
I'm needing some help with triggering an email with a slight change. Instead of a numerical value or entering the information into the cell manually, cells in column B will change to 'Y' triggered from a formula in other cells in that row. The formula for column B is =IF([@[Quantity in Stock]]>[@[Reorder Level]],,"Y"), showing that the inventory is low in stock and needs a re-order. I need to trigger an automated email when a cell value changes in column B to 'Y', so I'm notified automatically via email of the low stock. I've tried everything I can think of in altering codes already provided, but nothing seems to work for me... please help!
Reply
0
0
crystal
crystal     Kathryn F
This comment was minimized by the moderator on the site
Hi Kathryn F,
The following VBA code can help you solve the problem. Please give it a try. Thank you for your comment.
Dim xRg As Range
'Update by Extendoffice 20221019
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("B:B"), Target)
If xRg Is Nothing Then Exit Sub
If Target.Value = "Y" 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 xTarget As String
Dim xRg As Range
'Set xRg = Application.Range("B:B")
Set xRg = Intersect(Range("B:B"), Selection.EntireRow)
On Error GoTo Err01
If xRg.Value = "Y" Then
Call Mail_small_Text_Outlook
End If
Err01:
End Sub
Reply
Report
0
0
Esser123
Esser123
This comment was minimized by the moderator on the site
Hallo zusammen,

der Code w眉rde gut f眉r mein Vorhaben passen, aber gibt es die M枚glichkeit, dass er eine E-Mail beim speichern schreibt mit allen Zellen die ge盲ndert wurden? So wie es jetzt ist ,w眉rde er jede ge盲nderte Zelle einzeln senden. Dies ist dann problematisch wenn z.B. 10 Zellen angepasst werden was 10 E-Mails bedeuten w眉rde. Und gibt es die M枚glichkeit, die gesamte ge盲nderte Zelle bei mir von A bis Y in einer E-Mail zu senden? Bisher haut der ja die Zellnummer in die E-Mail, wenn aber jemand anders Filtert wird er die 脛nderung nicht mehr finden.
Reply
0
0
crystal
crystal     Esser123
This comment was minimized by the moderator on the site
Hi Esser123,
The following VBA codes can help. After modifying the cells in the specified range and save the workbook, an email will pop up to list all modified cells in the email body, and the workbook will be inserted as an attachment in the email as well. Please follow the following steps:
1. Open the worksheet that contains the cells you want to send emails based on, right click the sheet tab and click View Code from the right-click menu. Then copy the following code into the sheet(code) window.
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220921
Dim xAddress As String
Dim xDRg, xRgSel, xRg As Range

xAddress = "A1:A8"
Set xDRg = Range(xAddress)
Set xRgSel = Intersect(Target, xDRg)
On Error GoTo Err1
If Not xRgSel Is Nothing Then
If ThisWorkbook.gChangeRange = "" Then
ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
Else
Set xRg = Range(ThisWorkbook.gChangeRange)
Set xRg = Application.Union(xRg, xRgSel)
ThisWorkbook.gChangeRange = xRg.AddressLocal(False, False, xlA1, True, False)
End If
End If
Exit Sub
Err1:
      ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
End Sub

2. In the Visual Basic editor, double click ThisWorkbook in the left pane, then copy the following VBA code to the ThisWorkbook(Code) window.
Option Explicit
Public gChangeRange As String
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
'Updated by Extendoffice 20220921
Dim xRgSel, xRg As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String
'On Error Resume Next
On Error GoTo Err1
Set xRg = Range(gChangeRange)
If Not xRg Is Nothing Then
   Set xOutApp = CreateObject("Outlook.Application")
        Set xMailItem = xOutApp.CreateItem(0)
        xMailBody = "Email Body: " & vbCrLf & "The following cells were modified:" & xRg.Address(False, False)
        With xMailItem
            .To = "Email Address"
            .Subject = "Worksheet modified in " & ThisWorkbook.FullName
            .Body = xMailBody
            .Attachments.Add (ThisWorkbook.FullName)
            .Display
        End With
        Set xRgSel = Nothing
        Set xOutApp = Nothing
        Set xMailItem = Nothing
End If
Err1:
gChangeRange = ""
End Sub
Reply
Report
0
0
Daria Altstadt
Daria Altstadt
This comment was minimized by the moderator on the site
Hello, I have created a similar code but I would like to *** a condition where if a cell value is deleted that is will not send an email when it is save/closed. It will only send an email when a cell value has been entered. Do you know how to do this? This is my code:

CODE FOR AUTOMATIC EMAIL TO SOMEONE WHEN EXCEL WORKBOOK IS UPDATED

SHEET CODE:

Option Explicit 'Excel worksheet change event Range
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C3:D62")) Is Nothing Then
'Target.EntireRow.Interior.ColorIndex = 15
Range("XFD1048576").Value = 15
End If
If Not Intersect(Target, Range("I3:J21")) Is Nothing Then
'Target.EntireRow.Interior.ColorIndex = 15
Range("XFD1048576").Value = 15
End If
End Sub


WORKBOOK CODE:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Me.Saved = False Then Me.Save

Dim xOutApp As Object
Dim xMailItem As Object
Dim xName As String

If Range("XFD1048576").Value = 15 Then
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xName = ActiveWorkbook.FullName
With xMailItem
.To = "email"
.CC = ""
.Subject = "message"
.Body = "message!"
.Attachments.*** xName
.Display
'.send
End With
End If
Set xMailItem = Nothing
Set xOutApp = Nothing



End Sub

Private Sub Workbook_Open()
Range("XFD1048576").Clear
End Sub
Reply
0
0
hakana
hakana
This comment was minimized by the moderator on the site
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 so the code do not works in this case. Thank you in advance!
Reply
Report
0
0
crystal
crystal     hakana
This comment was minimized by the moderator on the site
Hi hakana,
The following VBA code can help you solve the problem. Please give it a try. Thank you for your feedback.

<div data-tag="code">Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2022/04/15
Dim xRgSel As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String
Dim xBoolean As Boolean
Dim xItsRG As Range
Dim xDDs As Range
Dim xDs As Range
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xBoolean = False
Set xRg = Range("E2:E13")

Set xItsRG = Intersect(Target, xRg)
Set xDDs = Intersect(Target.DirectDependents, xRg)
Set xDs = Intersect(Target.Dependents, xRg)
If Not (xItsRG Is Nothing) Then
Set xRgSel = xItsRG
xBoolean = True
ElseIf Not (xDDs Is Nothing) Then
Set xRgSel = xDDs
xBoolean = True
ElseIf Not (xDs Is Nothing) Then
Set xRgSel = xDs
xBoolean = True
End If


ActiveWorkbook.Save
If xBoolean Then
Debug.Print xRgSel.Address


Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xMailBody = "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") & "."

With xMailItem
.To = "Email Address"
.Subject = "Worksheet modified in " & ThisWorkbook.FullName
.Body = xMailBody
.Attachments.Add (ThisWorkbook.FullName)
.Display
End With
Set xRgSel = Nothing
Set xOutApp = Nothing
Set xMailItem = Nothing
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Reply
Report
0
0
Kmac
Kmac
This comment was minimized by the moderator on the site
Is it possible to change this so it only displays the email if a cell in a range has been changed to say "Yes". Would like it to do nothing if it is any other value.
Reply
Report
0
0
There are no comments posted here yet
Load More
Please leave your comments in English
Guest
Posting as Guest
脳
Rate this post:
Reset
0   Characters
Suggested Locations