Merhaba arkadaşlar, aslında benzeri bir çok konu mevcut olduğunu gördüm. Fakat hiç birinde tam manasıyla koşullu bir mail gönderme işlemi başarıyla sonuçlanmamış.
Koşullu mail den kastımız Saturlardaki belirli koşullara göre belirtilen bir maile e posta gönderimini sağlamak. Benim yapmaya çalıştığım muayene takip formu var. Bu formda araçların muayene tarihleri giriliyor ve bir sonraki muayene tarihi hesaplanarak kalan gün hesabı yapılıyor. koşul bu kalan gün 10 gün veya belirli bir güne yaklaştığında belirtilen bir e postaya mail atmasını sağlamak. ekte basit bir form düzenledim. Bilgisi olan arkadaşların katılımlarıyla biz acemi olan arkadaşları aydınlatacağından eminim. Saygılar...
Benzer bir istek aşağıdaki linkte de yapılmış. Aşağıda örnek bir kod mevcut fakat koşul kısmını nasıl yapacağımı bilemedim.
http://www.excel.web.tr/f48/abonelik-bitimiyle-ilgili-email-yollama-t147866.html
Koşullu mail den kastımız Saturlardaki belirli koşullara göre belirtilen bir maile e posta gönderimini sağlamak. Benim yapmaya çalıştığım muayene takip formu var. Bu formda araçların muayene tarihleri giriliyor ve bir sonraki muayene tarihi hesaplanarak kalan gün hesabı yapılıyor. koşul bu kalan gün 10 gün veya belirli bir güne yaklaştığında belirtilen bir e postaya mail atmasını sağlamak. ekte basit bir form düzenledim. Bilgisi olan arkadaşların katılımlarıyla biz acemi olan arkadaşları aydınlatacağından eminim. Saygılar...
Benzer bir istek aşağıdaki linkte de yapılmış. Aşağıda örnek bir kod mevcut fakat koşul kısmını nasıl yapacağımı bilemedim.
http://www.excel.web.tr/f48/abonelik-bitimiyle-ilgili-email-yollama-t147866.html
Kod:
Sub Vadesi_yaklaşanlar()
Dim a As Long, b As Long, C As Long, i As Long
Dim OutApp As Object
Dim NewMail As Object
Dim erb As Long, bag As Long
Table_Ac = "<table width='650px' cellpadding='3px' style=';background-color: #FFFFFF;border: 1px solid;border-collapse:" & _
"collapse; border-color: #ddd' rules='all'><colgroup><col style='background-color: #f8f8f8;'><col><col></colgroup>"
td1_ac = "<td style='background-color: #f8f8f8;color: #161120;text-align: left;font-family: Times New Roman; font-weight: bold'>"
td2_ac = "<td style='text-align: left;background-color: #f8f8f8'>"
For a = 3 To Sayfa1.Range("A65536").End(3).Row
bugünongun = CDate(Format(CDate(Date) + 10, "dd.mm.yyyy"))
bugün = CDate(Format(CDate(Date), "dd.mm.yyyy"))
If CDate(Sayfa1.Cells(a, 8)) <= bugünongun And CDate(Sayfa1.Cells(a, 8)) >= bugün Then
'bugün = Format(CLng(CDate(VBA.Date)), "dd.mm.yyyy")
kayitlitarih = Format(CLng(CDate(Sayfa1.Cells(a, 8))) - 10, "dd.mm.yyyy")
kayitlitarih1 = Format(CLng(CDate(Sayfa1.Cells(a, 8))), "dd.mm.yyyy")
'If kayitlitarih <= bugün And Sayfa1.Cells(a, 9) = Empty Then
'If kayitlitarih <= bugün Then
erbfark = Val((kayitlitarih1)) - Val(bugün)
erbfark1 = Val(bugün) - Val((kayitlitarih1))
If erbfark > 0 Then
Sayfa1.Cells(a, 9) = "Abone bitimine " & erbfark & " gün kaldı."
Else
Sayfa1.Cells(a, 9) = "Abone bitim süresi " & erbfark1 & " gün geçti."
End If
On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If OutApp Is Nothing Then
Application.ActivateMicrosoftApp (xlMicrosoftMail)
End If
Set NewMail = OutApp.CreateItem(olMailItem)
With NewMail
.To = Sayfa1.Cells(a, 10).Text
'.CC = "assenucler@gmail.com"
'.bcc = "assenucler@gmail.com"
.Subject = "Vadesi yaklaşanların listesi"
.HTMLBody = "Vadesi yaklaşanlar.<br/><br/>" & Table_Ac
For i = 1 To 8
.HTMLBody = .HTMLBody & "<tr width='50%'>" & td1_ac & Sayfa1.Cells(1, i + 1) & ": </td>"
.HTMLBody = .HTMLBody & td2_ac & Sayfa1.Cells(a, i + 1) & "</td></tr>"
Next i
.HTMLBody = .HTMLBody & "</table>"
.Save
.display '.display (1) silindi
End With
'End If
End If
Next a
End Sub