koşula göre mail atmak

[iskenderozdemir]

Merhaba,

"I" sütunundaki hesaplanmış değerler 0 dan büyük 7 den küçük koşuluna göre ilgili satır ve satırları seçerek mail atmasını istiyorum. Destek olabilir misiniz.

Teşekkür ederim.

 

[Trilenium]

Sub MailGonder()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim i As Integer
Dim rng As Range
Dim cel As Range
Dim bodyText As String

' Outlook nesneleri oluştur
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)

' 3. satırdan başlayarak I sütununu kontrol et
For i = 3 To Cells(Rows.Count, "I").End(xlUp).Row
If Cells(i, "I").Value > 0 And Cells(i, "I").Value < 7 Then
' G, H ve I sütunlarını seç
Set rng = Union(Cells(i, "G"), Cells(i, "H"), Cells(i, "I"))
bodyText = bodyText & "Satır " & i & ": " & rng.Address & vbCrLf
End If
Next i

' Mail içeriklerini ayarla ve gönder
With OutlookMail
.To = "alici@ornek.com" ' Mail gönderilecek kişi
.Subject = "Özel Koşullu Veri Bildirimi"
.Body = "Belirtilen koşulları sağlayan hücreler:" & vbCrLf & vbCrLf & bodyText
'.Send ' Kullanmak istersen en baştaki tırnak işaretini kaldır
End With

' Temizle
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub

 

[iskenderozdemir]

Günaydın, çok teşekkür ederim Trilenium elinize sağlık, mail atma şartı da olması gerekiyordu bu durumu ifade etmemişim "I" sütununda bir hesaplama var. Hesaplanan değer >=0 ve <=7 koşulu oluştuğunda otomatik gönderme yapabilir miyiz.

 

[iskenderozdemir]

Merhaba,

Birde
Belirtilen koşulları sağlayan hücreler: Satır 3: $C$3,$H$3:$I$3 bu şekilde mail içine yazmış hücre içinde ne yazıyorsa onu getirebilir miyiz.
Tekrar teşekkür ederim

 

[pitchoute]

Yardımcı olabilmek adına, @Trilenium kodunu şu şekilde revize edebilirsiniz;

Sub MailGonder()
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Dim i As Long
    Dim bodyText As String
    Dim lastRow As Long

    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)

    With ThisWorkbook.Sheets("Sayfa1") ' Sayfanızın adını buraya yazınız
        lastRow = .Cells(.Rows.Count, "I").End(xlUp).Row

        For i = 3 To lastRow
            If .Cells(i, "I").Value >= 0 And .Cells(i, "I").Value <= 7 Then
                If .Cells(i, "J").Value <> "Mail Gönderildi" Then
                    bodyText = bodyText & "Satır " & i & ": "
                    bodyText = bodyText & "G = " & .Cells(i, "G").Value & ", "
                    bodyText = bodyText & "H = " & .Cells(i, "H").Value & ", "
                    bodyText = bodyText & "I = " & .Cells(i, "I").Value & vbCrLf
                    .Cells(i, "J").Value = "Mail Gönderildi"
                End If
            End If
        Next i
    End With

    If bodyText <> "" Then
        With OutlookMail
            .To = "alici@ornek.com" ' Mail gönderilecek kişi
            .Subject = "Özel Koşullu Veri Bildirimi"
            .Body = "Belirtilen koşulları sağlayan hücreler:" & vbCrLf & vbCrLf & bodyText
            .Send  ' E-postayı gönder
            ' .Display ile e-posta penceresini görüntüleyebilirsiniz
        End With
    End If

    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
End Sub

 

[iskenderozdemir]

Teşekkür ederim ilginiz için pitchoute, mail içine metin olarak yazıyor. Ama otomatik olarak mail atmıyor, tarih değiştiğinde "I" sütununda kalan gün sayıları değişmekte. bu hesaplama olduğunda eğer sonuç <=7 olursa otomatik mail atmasını istiyorum. Bunu sitede bulduğum örneklerde farklı
"Private Sub Worksheet_Calculate()
End Sub"
denemelerle yapmaya çalıştım fakat yapamadım. Açık olan diğer dosyalar hesaplama yaptığında bu makroda çalışıyor.
Yardımlarınız için çok teşekkür ederim

 

[pitchoute]

Merhabalar, şöyle dener misiniz;

' Bu kodu ilgili sayfanın kod penceresine yerleştirin
Private Sub Worksheet_Calculate()
    On Error Resume Next ' Hataları yoksaymak için

    Dim i As Long
    Dim bodyText As String
    Dim lastRow As Long
    Dim currentValue As Variant
    Dim previousValue As Variant
    
    Application.EnableEvents = False
    With Me
        lastRow = .Cells(.Rows.Count, "I").End(xlUp).Row
        For i = 3 To lastRow
            currentValue = .Cells(i, "I").Value
            previousValue = .Cells(i, "K").Value
            If IsNumeric(currentValue) Then
                If currentValue >= 0 And currentValue <= 7 Then
                    If .Cells(i, "J").Value <> "Mail Gönderildi" Then
                        bodyText = bodyText & "Satır " & i & ": "
                        bodyText = bodyText & "G = " & .Cells(i, "G").Value & ", "
                        bodyText = bodyText & "H = " & .Cells(i, "H").Value & ", "
                        bodyText = bodyText & "I = " & currentValue & vbCrLf
                        .Cells(i, "J").Value = "Mail Gönderildi"
                    End If
                End If
            End If
            If currentValue <> previousValue Then
                .Cells(i, "K").Value = currentValue
            End If
        Next i
    End With
    If bodyText <> "" Then
        Call MailGonder(bodyText)
    End If
    Application.EnableEvents = True
End Sub

' Bu prosedürü bir modüle yerleştirin
Sub MailGonder(bodyText As String)
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    With OutlookMail
        .To = "alici@ornek.com" ' Mail gönderilecek kişi
        .Subject = "Özel Koşullu Veri Bildirimi"
        .Body = "Belirtilen koşulları sağlayan hücreler:" & vbCrLf & vbCrLf & bodyText
        .Send  ' E-postayı gönder
        ' .Display ' E-posta penceresini görüntülemek isterseniz bu satırı kullanabilirsiniz
    End With
    
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
End Sub

 

[iskenderozdemir]

Merhaba pitchoute, Trilenium harikasınız emeğinize sağlık. Çok teşekkür ediyorum. Mükemmel oldu.
İyi günler dilerim.

 

[pitchoute]

Rica ederim, iyi çalışmalar