Excel Belirlenen Tarihlerde Hatırlatma E-maili Atsın

[use2000]

Merhabalar,

Excel'in A sütununda açıklama K sütununda lisans bitiş tarihleri, L sütununda da ilgili kişilerin e-mail'leri mevcut. K sütunundaki lisans bitiş tarihinde L sütununda bulunan e-mail adresine A hücresindeki yazıyı e-mail atsın istiyorum. Bunu yapabilir miyiz?

Teşekkürler,

 

[antonio]

Arama yerine Outlook yazarsanız sayısız örnek çıkacaktır. Aşağıdaki bağlantıdan da yararlanabilirsiniz.
http://www.excel.web.tr/f14/personel-dooum-gunu-programy-t112826.html

 

[use2000]

Konuyu arattım ama istediğime yakın bir şey bulamadım. Yardımcı olunabilirse çok sevinirim. Teşekkürler

 

[antonio]

Konuyu arattım ama istediğime yakın bir şey bulamadım. Yardımcı olunabilirse çok sevinirim. Teşekkürler

Aşağıdaki kodları deneyin

Sub epostalar()

'ÖNEMLİ HATIRLATMA: Tools >> References menüsünden Microsoft Outlook xx.x Object Library seçilmelidir.

Dim outapp As Outlook.Application, outmail As Outlook.MailItem
Dim sh As Worksheet, alan As Range, ss As Long
Set outapp = CreateObject("Outlook.Application")
Set outmail = outapp.CreateItem(olMailItem)
Set sh = Sheets("Sayfa1")
ss = sh.Range("K" & Rows.Count).End(3).Row
Set alan = sh.Range("K2:K" & ss)
For Each tarih In alan
    If CDate(Date) = CDate(tarih.Value) Then
        GoTo olumlu
    End If
Next tarih
olumsuz:
        MsgBox "Bugüne ait gönderilecek eposta yok", vbExclamation, "BULUNAMADI MESAJI"
Exit Sub
olumlu:
With outmail
sat = tarih.Row
    .To = sh.Range("L" & sat).Value
    .Subject = "Lisansınızın kullanım süresi"
    .Body = sh.Range("A" & sat).Value
    .Display
'    .Send   'Bunu da aktif hale getirirseniz, size sormadan mesaj gönderilir.
End With
End Sub

 

[use2000]

Aşağıdaki kodları deneyin

Sub epostalar()

'ÖNEMLİ HATIRLATMA: Tools >> References menüsünden Microsoft Outlook xx.x Object Library seçilmelidir.

Dim outapp As Outlook.Application, outmail As Outlook.MailItem
Dim sh As Worksheet, alan As Range, ss As Long
Set outapp = CreateObject("Outlook.Application")
Set outmail = outapp.CreateItem(olMailItem)
Set sh = Sheets("Sayfa1")
ss = sh.Range("K" & Rows.Count).End(3).Row
Set alan = sh.Range("K2:K" & ss)
For Each tarih In alan
    If CDate(Date) = CDate(tarih.Value) Then
        GoTo olumlu
    End If
Next tarih
olumsuz:
        MsgBox "Bugüne ait gönderilecek eposta yok", vbExclamation, "BULUNAMADI MESAJI"
Exit Sub
olumlu:
With outmail
sat = tarih.Row
    .To = sh.Range("L" & sat).Value
    .Subject = "Lisansınızın kullanım süresi"
    .Body = sh.Range("A" & sat).Value
    .Display
'    .Send   'Bunu da aktif hale getirirseniz, size sormadan mesaj gönderilir.
End With
End Sub

İlginiz için teşekkür ederim ancak ben makro kaydedip daha sonra makroyu düzenleyip sizin vermiş olduğunuz kodu kopyaladığımda ve makroyu çalıştırdığımda başarı sağlayamadım. Sanrım bir yerlerde hata yapıyorum. Nasıl yapmam gerektiğini tarif edebilirseniz çok mutlu olurum.