Belirli bir tarihe geldiğinde mail gönderme

[cagri24]

Merhabalar,

Konuyla ilgili daha önce de benzer başlıklar açılmış ancak aradığımı bir türlü bulamadım. Benzeri varsa o sayfaya yönlendirirseniz çok memnun olurum.

Araç muayenele tarihlerinden 7 gün önce belirli kişilere mail atmasını istiyorum. Örneğin sayfa içerisindeki adrese gönderimi sağlanabilir.

Örnek dosya ektedir.

Şimdiden teşekkürler.

 

[tugkan]

Merhaba,
Aşağıdaki link belki işinize yarayabilir.
Belirlenen Tarihte Mail Atma

 

[cagri24]

Merhaba sayın tugkan,
Gönderdiğiniz sayfa benim işime yarayacak ancak belirli bir saatte gönderime göre yazılmış kodlar.

Private Sub Workbook_Open()
Application.OnTime TimeValue("11:00:00"), "SendEmail"
End Sub

Buradaki ifadeyi 7 gün önceyse mail gönder diye değiştirmem gerek. Bu konuda yardımcı olabilir misiniz?

 

[tugkan]

Merhaba,
Üzgünüm o kadar detaylı bilgiye sahip değilim. Makro konusunda tecrübeli arkadaşlar yardımcı olabilir belki.

 

[cagri24]

Yine de teşekkür ederim

Yardımcı olabilecek arkadaşlar var mı?

 

[cagri24]

Selamlar,

Konu biraz acil. Yardımcı olabilecek arkadaşlar var mı acaba?

 

[cagri24]

Selamlar,
Eskiden bir sorunumu bu sayfada yazdığımda mutlaka cevap verilirdi. Son zamanlarda olumlu veya olumsuz yardımcı olan bile olmuyor.

 

[cagri24]

Arkadaşlar gerçekten yardım edebilecek kimse yok mu? Konu benim için acil olmasa bu kadar ısrarcı olmam.

 

[Korhan Ayhan]

Deneyiniz.

Dosyanızı açtığınızda "Sayfa1" isimli sayfanız kontrol edilir. Uygun veriler onayınız doğrultusunda mail olarak gönderilir.

Private Sub Workbook_Open()
    Dim Veri As Range, Say As Long
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
   
    Onay = MsgBox("Zamanı yaklaşan muayeneler için hatırlatma maili gönderilecektir." & Chr(10) & _
                  "İşlemi onaylıyor musunuz?", vbCritical + vbYesNo)
    If Onay = vbNo Then
        MsgBox "Mail gönderme işlemi iptal edilmiştir."
        Exit Sub
    End If
           
    For Each Veri In Sheets("Sayfa1").Range("I4:I1000")
        If Date = Veri.Value Then
            With Application
                .EnableEvents = False
                .ScreenUpdating = False
            End With
           
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
       
            On Error Resume Next
            With OutMail
                .Display
                .To = "Buraya mail adreslerini yazınız..."
                .CC = ""
                .BCC = ""
                .Subject = "Muayene Tarihi Hatırlatma"
                .Body = "Merhaba," & Chr(10) & Chr(10) & "Araç muayenenizin tarihinin dolmasına 1 hafta kalmıştır." & _
                        Chr(10) & Chr(10) & "Bu mail hatırlatma amacıyla gönderilmiştir." & Chr(10) & Chr(10) & Cells(Veri.Row, "B").Value
                .Send   'or use .Display
            End With
            On Error GoTo 0
       
            With Application
                .EnableEvents = True
                .ScreenUpdating = True
            End With
       
            Set OutMail = Nothing
            Set OutApp = Nothing
        End If
        Say = Say + 1
    Next
   
    MsgBox "Hatırlatma mailleri gönderilmiştir." & Chr(10) & Chr(10) & "Toplam ; " & Say & " adet mail gönderilmiştir."
End Sub

 

[cagri24]

Korhan Bey çok teşekkürler,
Elinize sağlık, kodlar tam olarak istediğim gibi çalışıyor. Sadece dosya açıldığında çalıştır kısmını yapamadım. Onun yerine "Sayfa1" i aktif ettiğimde çalışıyor mu diye denedim, çalışıyor. Verdiğiniz kodları yerleştirdim, ekten inceleyebilirsiniz.

 

[cagri24]

Korhan bey tekrar selamlar,

Kodları "This workbook" ta çalıştırmak gerekiyormuş, şimdi çözdüm. Çok teşekkürler desteğiniz için.

Saygılar.

 

[uguraslanoglu]

Deneyiniz.

Dosyanızı açtığınızda "Sayfa1" isimli sayfanız kontrol edilir. Uygun veriler onayınız doğrultusunda mail olarak gönderilir.

Private Sub Workbook_Open()
    Dim Veri As Range, Say As Long
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
  
    Onay = MsgBox("Zamanı yaklaşan muayeneler için hatırlatma maili gönderilecektir." & Chr(10) & _
                  "İşlemi onaylıyor musunuz?", vbCritical + vbYesNo)
    If Onay = vbNo Then
        MsgBox "Mail gönderme işlemi iptal edilmiştir."
        Exit Sub
    End If
          
    For Each Veri In Sheets("Sayfa1").Range("I4:I1000")
        If Date = Veri.Value Then
            With Application
                .EnableEvents = False
                .ScreenUpdating = False
            End With
          
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
      
            On Error Resume Next
            With OutMail
                .Display
                .To = "Buraya mail adreslerini yazınız..."
                .CC = ""
                .BCC = ""
                .Subject = "Muayene Tarihi Hatırlatma"
                .Body = "Merhaba," & Chr(10) & Chr(10) & "Araç muayenenizin tarihinin dolmasına 1 hafta kalmıştır." & _
                        Chr(10) & Chr(10) & "Bu mail hatırlatma amacıyla gönderilmiştir." & Chr(10) & Chr(10) & Cells(Veri.Row, "B").Value
                .Send   'or use .Display
            End With
            On Error GoTo 0
      
            With Application
                .EnableEvents = True
                .ScreenUpdating = True
            End With
      
            Set OutMail = Nothing
            Set OutApp = Nothing
        End If
        Say = Say + 1
    Next
  
    MsgBox "Hatırlatma mailleri gönderilmiştir." & Chr(10) & Chr(10) & "Toplam ; " & Say & " adet mail gönderilmiştir."
End Sub

Merhaba, dahil oluyorum ama, aynı senaryoyu, yaklaşan ödemelerin tümü aynı mail gövdesinde yer alacağı şekilde belirlenen birkaç adrese mail olarak göndermek istesek nasıl yapmamız gerekirdi acaba?

 

[Can127ı]

Dosyaları açamıyorum, altın üye olmak için ne yapmalıyım?

 

[Korhan Ayhan]

Linki inceleyiniz.

Altın Üyelik

Değerli Üyemiz, Forumda DOSYA EKLEME ile DOSYA İNDİRME işlemleri için ve yayınlanan Video Dersleri izleyebilmek için ALTIN ÜYELİK gerekmektedir. ALTIN ÜYELİK ONLİNE SİPARİŞ İÇİN TIKLAYIN ALTIN ÜYELİK fiyatlar ; 1 Yıl = 500 TL KDV Dahil 2 Yıl = 800 TL KDV Dahil DİKKAT : Forumun temel amacı...

www.excel.web.tr