Excel listesi üzerinde kayıtlı olan mail adreslerine, konu ve içerik bilgisiyle, zamanı geldiğinde bilgisayarımızın otomatik olarak mail göndermesini istiyoruz. Öncelikle; Excel listemizde üç zorunlu alanı dolduruyoruz.
(E-posta adresi, Konu, Açıklama) sonra Excel dosyasını farklı kaydet, makro içeren "xlsm" uzantılı olarak kaydediyoruz. Çalışma dosyasının sheet (sayfa1) adını "mail" olarak düzenleyin. (Kod bu isme göre) Mail sekmesi üzerinde mouse ile sağ klik "Kod Görüntüle" seçeneğine tıklayın.
.png)
Aşağıdaki kodu kopyalayın.
Sub Mail()
Dim OutApp As Object
Dim OutMail As Object
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim successCount As Long
' Hangi sayfada çalışacağını belirtin (Varsayılan olarak Aktif Sayfa)
Set ws = ThisWorkbook.Sheets("Mail") ' Sayfa adını buraya yazın
' Son kullanılan satırı bulun
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' Outlook uygulamasını oluşturun
Set OutApp = CreateObject("Outlook.Application")
' Başlangıçta başarılı gönderilen e-posta sayısını sıfırla
successCount = 0
' Her bir satır için e-posta gönder
For i = 2 To lastRow
' Yeni e-posta öğesi oluşturun
Set OutMail = OutApp.CreateItem(0)
With OutMail
' Alıcı adresini A sütunundan alın
.To = ws.Cells(i, 1).Value
' Konuyu B sütunundan alın
.Subject = ws.Cells(i, 2).Value
' İçeriği C sütunundan alın
.Body = ws.Cells(i, 3).Value
' E-posta gönderme işlemi başarılıysa sayacı artır
On Error Resume Next
.Send
If Err.Number = 0 Then successCount = successCount + 1
On Error GoTo 0
End With
Next i
' Tüm e-postalar gönderildikten sonra tek bir mesaj kutusu göster
MsgBox successCount & " e-posta gönderildi.", vbInformation, Application.UserName
End Sub
Kopyalan kodu, Açılan "Kod Görüntüle" penceresinin sol tarafına Sayfa1(Mail) satırına çift tıklayın, sağ tarafta yer alan boş çerçeveye "Ctrl+V" ile yapıştırın. (Aşağıdaki kod, Mail sayfasında kayıtlı mail adreslerinin gönderilmesi sağlar.)
.png)
"Kod Görüntüle" penceresinin sol tarafındaki "Bu çalışma kitabı" çift tıklayın ve aşağıdaki kodu sayfanın sağ tarafına yapıştırın. (Aşağıdaki kod, Mail sayfasında yer alan kodun açılışta çalışmasını sağlar) kaydet ikonuna basarak tüm pencere ve dosyayı kapatın.
Private Sub Workbook_Open()
Sayfa1.Mail
End Sub
.png)
.png)
Görev zamanlıyıcı (Task Scheduler) çalıştıralım Win+R tuşlarına bastıktan sonra "taskschd.msc" yazın, Tamam.
.png)
Görev zamanlıyıcı açıldıktan sonra, Eylem sekmesinden, "Temel Görev Oluştur" seçeneğine tıklayın.
.png)
.png)
.png)
.png)
.png)
.png)
.png)
.png)
Zaman geldiğinde, Görev zamanlayıcı Excel makro dosyasını açar. Açılırken kodu çalıştır iç koduyla mail gönderimi başlar. Mail gönderimi bitince, Mesaj penceresi belirir. "Tamam" butonuna basarak mesajı ardından da dosyayı kapatın.
.png)
.png)
Zaman ayarlı, mail gönder. Ek dosya ile...
İhtiyaçlar doğrultusunda, Excel listesine göre mail gönderme çalışması güncellendi. Aşağıdaki çalışma sayfasında, dosya eklenmesi için, Excel "D Sütun" D2 den itibaren, dosya yolunu yazabilir/kopyalayıp yapıştırabilirsiniz.
Dosya yolu yazılmış ise, ilgili klasörden dosyayı ek yaparak, "E-posta adresi" "A Sütun" A2 den itibaren yazılı olan mail adreslerine mail gönderimi yapmaktadır.
Ek herhangi bir dosya yok ise, "ilgili satıra dosya yolu eklenmemişse" üst kısımdaki çalışma gibi, "Konu, Açıklama" bilgilerini doldurarak mevcut tanımlı posta adresiniz kanalıyla mail gönderir.
Çalışma sayfası "Mail-EkDosya.xlsm" formatında kayıt hali, aşağıdaki gibidir. Sekme Adı "Mail" yapıldıktan sonra, Sağ klik "Kod görüntüle" tıklayın.
"Sayfa1 (Mail)" seçeneğine tıklayın; Sağ taraftaki pencereye, aşağıdaki kodu yapıştırın.
Sub Mail()
Dim OutApp As Object
Dim OutMail As Object
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim successCount As Long
Dim filePath As String
' Hangi sayfada çalışacağını belirtin (Varsayılan olarak Aktif Sayfa)
Set ws = ThisWorkbook.Sheets("Mail") ' Sayfa adını buraya yazın
' Son kullanılan satırı bulun
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' Outlook uygulamasını oluşturun
Set OutApp = CreateObject("Outlook.Application")
' Başlangıçta başarılı gönderilen e-posta sayısını sıfırla
successCount = 0
' Her bir satır için e-posta gönder
For i = 2 To lastRow
' Yeni e-posta öğesi oluşturun
Set OutMail = OutApp.CreateItem(0)
With OutMail
' Alıcı adresini A sütunundan alın
.To = ws.Cells(i, 1).Value
' Konuyu B sütunundan alın
.Subject = ws.Cells(i, 2).Value
' İçeriği C sütunundan alın
.Body = ws.Cells(i, 3).Value
' Ek dosya yolunu D sütunundan alın
filePath = ws.Cells(i, 4).Value
If filePath <> "" Then
.Attachments.Add filePath
End If
' E-posta gönderme işlemi başarılıysa sayacı artır
On Error Resume Next
.Send
If Err.Number = 0 Then successCount = successCount + 1
On Error GoTo 0
End With
Next i
' Tüm e-postalar gönderildikten sonra tek bir mesaj kutusu göster
MsgBox successCount & " e-posta gönderildi.", vbInformation, Application.UserName
' Outlook uygulamasını serbest bırakın
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
"BuÇalışmaKitabı" seçeneğine tıklayın; Sağ taraftaki pencereye, aşağıdaki kodu yapıştırın. Kaydet ikonuna basın, ardından çarpıya basarak sayfayı kapatın. Excel dosyasını da veri girişlerinizi tamamladıktan sonra kaydederek kapatın.
Kod:
Private Sub Workbook_Open()
Sayfa1.Mail
End Sub
Excel dosyası açıldığında veya yukarıda anlatılan "Görev zamanlayıcı (Task Scheduler) çalıştırılarak zaman kurulmasıyla, "Mail-EkDosya.xlsm" dosyasını kaydettiğiniz yolun içinde gösterilmesiyle, zamanı geldiğinde dosya açılacak, dosya açılınca otomatik olarak mail gönderimi gerçekleşecektir.
Mail geldiği anda "Ek dosya yolu belirtilenler", görünümler aşağıdaki gibidir.
Mail geldiği anda "Ek dosya yolu belirtilmeyen, Hücrenin boş olması, Ek olmadan mail gönderir.
Kod girilmiş halde hazır durumdaki dosya GoogleDrive adresine kaydedilerek paylaşıma açılmıştır. Dosyayı indirdikten sonra, RAR dosyasından Winrar ile çıkarıp, kaydedin. "E-posta adresi, Konu, Açıklama ve Dosya yolu" değiştirerek kullanabilirsiniz. İndirmek için Tıklayın.