Çözüldü Tarihi yakın olan ürünleri mail gönder

[omerap06]

Sub Düğme1_Tıkla()

Dim ws As Worksheet
Dim rngTarih As Range, cellTarih As Range
Dim acilAdres As String, acilDegilAdres As String
Dim mailKonu As String, mailIcerik As String
Dim outlookApp As Object
Dim outlookMail As Object
Dim sonSatir As Long

Set ws = ThisWorkbook.Sheets("LİSTE")

sonSatir = ws.Cells(ws.Rows.Count, "L").End(xlUp).Row
Set rngTarih = ws.Range("L7:L" & sonSatir)

mailKonu = "Tarihi Geçen Değerler"
mailIcerik = "Acil:" & vbCrLf

For Each cellTarih In rngTarih
If cellTarih.Value < Date - 10 And cellTarih.Value > Date - 30 Then
If acilAdres = "" Then
acilAdres = cellTarih.Row
Else
acilAdres = acilAdres & ", " & cellTarih.Row
End If
ElseIf cellTarih.Value <= Date + 10 And cellTarih.Value >= Date Then
If acilDegilAdres = "" Then
acilDegilAdres = cellTarih.Row
Else
acilDegilAdres = acilDegilAdres & ", " & cellTarih.Row
End If
End If
Next cellTarih

If acilAdres <> "" Then
mailIcerik = mailIcerik & "10 günden az kalanlar:" & vbCrLf
For Each rowNo In Split(acilAdres, ", ")
mailIcerik = mailIcerik & ws.Cells(rowNo, "L").Value & " - " & ws.Cells(rowNo, "B").Value & " - " & ws.Cells(rowNo, "F").Value & " - " & ws.Cells(rowNo, "G").Value & " - " & ws.Cells(rowNo, "H").Value & vbCrLf
Next rowNo
End If


If acilDegilAdres <> "" Then
mailIcerik = mailIcerik & vbCrLf & "Acil Değil:" & vbCrLf
For Each rowNo In Split(acilDegilAdres, ", ")
mailIcerik = mailIcerik & ws.Cells(rowNo, "L").Value & " - " & ws.Cells(rowNo, "B").Value & " - " & ws.Cells(rowNo, "F").Value & " - " & ws.Cells(rowNo, "G").Value & " - " & ws.Cells(rowNo, "H").Value & vbCrLf
Next rowNo
End If

Set outlookApp = CreateObject("Outlook.Application")

Set outlookMail = outlookApp.CreateItem(0)

With outlookMail
.To = "o.ankara19@hotmail.com"
.Subject = mailKonu
.Body = mailIcerik
.Send
End With

Set outlookMail = Nothing
Set outlookApp = Nothing

End Sub

Yapmak istediğim şu :listeden L sutunundaki tarihlere baksın 10 günden az olan var ise mailin konusunda "acil:" adı altında altına B F G H sutunundaki bilgiler yazsın ve yine 10 günden fazla ve 30 günden az olan tarihlere baksın "acil değil" adı altında B F G H sutunundaki bilgiler yazsın 30 günden fazla tarihi olanları ise hiç yazmasın isteğim bu dur kodu yazdım ama çıktısı attığım resimdeki gibi sadece 2 parça oluyor çözemedim yardım edebilecek bir üstadım var mı?

 

[DoğanD]

Merhaba,

Aslında dosya istediğiniz her şeyi yapıyor gibi görünüyor. Aşağıdaki satır bilgilerini tekrar bir kontrol edin. Kabaca 23.03.2024'den büyük ve 12.04.2024'den küçük değer arıyor Aciller için. Ve görebildiğim kadarıyla bu tarihler arasında da veri yok tablonuzda.

If cellTarih.Value < Date - 10 And cellTarih.Value > Date - 30 Then

 

[omerap06]

Merhaba Doğan Hocam,

Dediğinizi tam manasıyla anlayamadım müsaitlik durumunuz bulunuyosa birde direk excele bakabilirmisiniz.
hocam birde 10 günden daha az süre kalanları göstermiyor 2023 yılından parçalar var onları yazmıyor mesela

Merhaba,

Aslında dosya istediğiniz her şeyi yapıyor gibi görünüyor. Aşağıdaki satır bilgilerini tekrar bir kontrol edin. Kabaca 23.03.2024'den büyük ve 12.04.2024'den küçük değer arıyor Aciller için. Ve görebildiğim kadarıyla bu tarihler arasında da veri yok tablonuzda.

 

[DoğanD]

Tekrar merhaba,

Gönderdiğiniz dosya eski bir versiyon sanırım. Veriler ve kodlar farklı.

Değişikler ise şöyle;

For Each cellTarih In rngTarih
If cellTarih.Value < Date + 10 Then 'Bitiş tarihine 10 günden az kalanlar ve bitenler
If acilAdres = "" Then
acilAdres = cellTarih.Row
Else
acilAdres = acilAdres & ", " & cellTarih.Row
End If
ElseIf cellTarih.Value <= Date + 30 Then 'Bitiş tarihine 10-30 gün kalanlar
If acilDegilAdres = "" Then
acilDegilAdres = cellTarih.Row
Else
acilDegilAdres = acilDegilAdres & ", " & cellTarih.Row
End If
End If
Next cellTarih

Dosyanızda tarihi geçmiş olanlar da olduğu için Mail içerik baseini aşağıdaki şekilde değiştirdim.

mailIcerik = mailIcerik & "10 günden az kalanlar ve Bitenler:" & vbCrLf

Ayrıca gereksiz mail trafiği olmasın diye aşağıdaki mail gönderme kodunu Display olarak değiştirdim, düzeltirsiniz.

With outlookMail
.To = "o.ankara19@hotmail.com"
.Subject = mailKonu
.Body = mailIcerik
.display '.Send
End With

 

[omerap06]

Hocam elinize emeğinize sağlık oldu