[adem19031923]

Herkese Merhabalar,

Bir konuda desteğinize ihtiyacım bulunmaktadır. Ekte bulunan excel dosyasında birden fazla sekme var. Bu sekmelerin her birinde de (Yapılacaklar Listesi sekmesi hariç) aynı işlem olacak şekilde bir düzenleme yapmak istiyorum.

Özetle; E sütununda girilen tarihe 3 gün kala aşağıdaki mail adresine mail ulaşmasını istiyorum. Sonrasında 2 gün kala, sonrasında 1 gün kala ve son gün mail gidecek şekilde kod yazamadım. Destek olabilir misiniz? Şimdiden çok teşekkür ederim.

[erseldemirel2]

Örnek bir kod hazırladım bir kontrol ediniz.

Kod: Tümünü seç

Sub TarihKontroluVeMailGonderimi()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim currentDate As Date
    Dim targetDate As Date
    Dim mailSubject As String
    Dim mailBody As String
    Dim mailRecipient As String
    Dim objOutlook As Object
    Dim objMail As Object
   
    ' Hedef dosya ve sayfa adını güncelleyin
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Risk Değerlendirme")
   
    ' Outlook nesnelerini oluştur
    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
   
    ' Son satırı bulun
    lastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
   
    ' Tarih kontrolü ve mail gönderimi için döngü
    For i = 2 To lastRow
        currentDate = Date
        targetDate = ws.Cells(i, "E").Value
       
        ' Hedef tarihe göre mail gönderimi
        If targetDate - currentDate = 3 Then
            mailSubject = "3 gün kaldı"
            mailBody = "Merhaba, hedef tarih 3 gün sonra dolacak."
            mailRecipient = "e@e.com"
        ElseIf targetDate - currentDate = 2 Then
            mailSubject = "2 gün kaldı"
            mailBody = "Merhaba, hedef tarih 2 gün sonra dolacak."
            mailRecipient = "e@e.com"
        ElseIf targetDate - currentDate = 1 Then
            mailSubject = "1 gün kaldı"
            mailBody = "Merhaba, hedef tarih yarın dolacak."
            mailRecipient = "e@e.com"
        ElseIf targetDate = currentDate Then
            mailSubject = "Son gün"
            mailBody = "Merhaba, hedef tarih bugün dolacak."
            mailRecipient = "e@e.com"
        End If
       
        ' Mail gönderimi
        With objMail
            .subject = mailSubject
            .body = mailBody
            .To = mailRecipient
            .Send
        End With
    Next i
   
    ' Outlook nesnelerini temizle
    Set objMail = Nothing
    Set objOutlook = Nothing
   
    MsgBox "Mail gönderimi tamamlandı.", vbInformation
End Sub