VBA makro untuk mengirim email dari Excel melalui Outlook

Masalahnya muncul mengatur pengorganisasian surat dengan daftar pengguna email di Excel. Selain itu, dalam setiap huruf Anda perlu menentukan beberapa data yang bersifat individual untuk setiap pengguna. Saya mencoba menerapkan fungsi ini menggunakan vba macro di Excel, yang mengirim surat melalui profil surat Outlook yang dikonfigurasikan di komputer. Di bawah ini adalah keputusan saya.

Misalkan kita memiliki file Excel yang berisi kolom berikut:

Email Pengguna | Nama lengkap | Kata Sandi Terakhir Ubah Waktu | Status akun

Sebagai bagian dari tugas saya, setiap pengguna dari daftar perlu mengirim surat berupa:

Tema: Status akun di domain winitpro.ru
Surat badan: Dear% FullUsername%
Akun Anda di domain winitpro.ru adalah% status%
Waktu Perubahan Kata Sandi Terakhir:% pwdchange%Kiat. Jika untuk akun pengguna Anda perlu mendapatkan nilai dari salah satu atribut pengguna di Active Directory, Anda dapat menggunakan solusi dari artikel Fungsi Excel untuk mendapatkan data pengguna dari AD.

Buat tab makro: baru Lihat -> Makro. Masukkan nama makro send_email dan tekan tombol Buat:

Di editor VBA yang terbuka, rekatkan kode berikut (saya berikan semua komentar yang diperlukan). Untuk mengotomatiskan pengiriman surat, saya akan menggunakan fungsi CreateObject ("Outlook.Application"), yang memungkinkan Anda membuat dan menggunakan objek aplikasi Outlook dalam skrip.

Itu penting. Profil email Outlook harus diinstal dan dikonfigurasi pada komputer yang mengirim surat. Dari kotak ini (dan alamat) akan dikirim.

Sub send_email ()
Redup olapp sebagai objek
Dim olMailItm Sebagai Objek
Dim iCounter Sebagai Integer
Dim dest sebagai varian
Dim SDest As String
'' baris subjek
strSubj = "Status akun di domain winitpro.ru"
On Error GoTo dbg
'buat objek baru tipe Outlook
Setel olApp = CreateObject ("Outlook.Application")
Untuk iCounter = 1 Ke WorksheetFunction.CountA (Kolom (1))
'buat item (surat) baru di Outlook
Setel olMailItm = olApp.CreateItem (0)
strBody = ""
useremail = Sel (iCounter, 1) .Nilai
FullUsername = Cells (iCounter, 2) .Nilai
Status = Sel (iCounter, 4) .Nilai
pwdchange = Sel (iCounter, 3) .Nilai
'' Bentuk badan surat itu
strBody = "Dear" & FullUsername & vbCrLf
strBody = strBody & "Akun Anda di domain winitpro.ru" & Status & vbCrLf
strBody = strBody & "Waktu perubahan kata sandi terakhir:" & pwdchange & vbCrLf
olMailItm.To = useremail
olMailItm.Subject = strSubj
olMailItm.BodyFormat = 1
'1 - format teks surat, 2 - format HTML
olMailItm.Body = strBody
olMailItm. Kirim
Baris berikutnya dapat digunakan untuk men-debug teks surat dengan mengomentari sebelumnya
'MsgBox strBody
Setel olMailItm = Tidak Ada
ICounter selanjutnya
Setel olApp = Tidak Ada
dbg:
tampilan kesalahan, jika ada
If Err.Description "" Maka MsgBox Err.Description
End sub

File Excel ini harus disimpan dengan ekstensi xlsm (Format buku kerja Excel dengan dukungan makro). Untuk memulai distribusi, pilih prosedur yang dibuat (makro) dan klik tombol eksekusi.

Makro akan secara berurutan memilah-milah semua baris dalam lembar kerja Excel, menghasilkan dan mengirim satu surat ke setiap Email dari daftar.