Bagaimana cara mengirim setiap lembar ke alamat email yang berbeda dari Excel?
Jika Anda memiliki buku kerja dengan beberapa lembar kerja, dan ada alamat email di sel A1 setiap lembar. Sekarang, Anda ingin mengirim setiap lembar dari buku kerja sebagai lampiran ke penerima terkait di sel A1 satu per satu. Bagaimana Anda bisa menyelesaikan tugas ini di Excel? Artikel ini, saya akan memperkenalkan kode VBA untuk mengirim setiap lembar sebagai lampiran ke alamat email yang berbeda dari Excel.
Kirim setiap lembar ke alamat email yang berbeda dari Excel dengan kode VBA
Kode VBA berikut dapat membantu Anda mengirim setiap lembar sebagai lampiran ke penerima yang berbeda, lakukan seperti ini:
1. tekan Alt + F11 tombol secara bersamaan untuk membuka Microsoft Visual Basic untuk Aplikasi jendela.
2. Lalu klik Menyisipkan > Modul, dan salin dan tempel kode VBA di bawah ini ke dalam jendela.
Kode VBA: Kirim setiap lembar sebagai lampiran ke alamat email yang berbeda
Sub Mail_Every_Worksheet()
'Updateby ExtendOffice
Dim xWs As Worksheet
Dim xWb As Workbook
Dim xFileExt As String
Dim xFileFormatNum As Long
Dim xTempFilePath As String
Dim xFileName As String
Dim xOlApp As Object
Dim xMailObj As Object
On Error Resume Next
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
xTempFilePath = Environ$("temp") & "\"
If Val(Application.Version) < 12 Then
xFileExt = ".xls": xFileFormatNum = -4143
Else
xFileExt = ".xlsm": xFileFormatNum = 52
End If
Set xOlApp = CreateObject("Outlook.Application")
For Each xWs In ThisWorkbook.Worksheets
If xWs.Range("S1").Value Like "?*@?*.?*" Then
xWs.Copy
Set xWb = ActiveWorkbook
xFileName = xWs.Name & " of " _
& VBA.Left(ThisWorkbook.Name, VBA.InStr(ThisWorkbook.Name, ".") - 1) & " "
Set xMailObj = xOlApp.CreateItem(0)
xWb.Sheets.Item(1).Range("S1").Value = ""
With xWb
.SaveAs xTempFilePath & xFileName & xFileExt, FileFormat:=xFileFormatNum
With xMailObj
'specify the CC, BCC, Subject, Body below
.To = xWs.Range("S1").Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add xWb.FullName
.Display
End With
.Close SaveChanges:=False
End With
Set xMailObj = Nothing
Kill xTempFilePath & xFileName & xFileExt
End If
Next
Set xOlApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
- S1 adalah sel yang berisi alamat email yang ingin Anda kirimi email. Silakan ubah sesuai kebutuhan Anda.
- Anda dapat menentukan CC, BCC, Subjek, Badan untuk Anda sendiri dalam kode;
- Untuk mengirim email secara langsung tanpa membuka jendela pesan baru berikut, Anda perlu mengubah .Tampilan untuk .Mengirim.
3. Lalu tekan F5 kunci untuk menjalankan kode ini, dan setiap lembar dimasukkan ke jendela pesan baru sebagai lampiran secara otomatis, lihat tangkapan layar:
4. Terakhir tinggal klik Kirim tombol untuk mengirim setiap email satu per satu.
Alat Produktivitas Kantor Terbaik
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...
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!
