• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Tarih koşuluna göre otomatik outlook maili

N

Nilay Karabasogullari

Katılım
12 Ekim 2017
Mesajlar
123
Excel Vers. ve Dili
2011
Herkese merhabalar ve iyi haftalar,

Ben sağlık kurumunda çalışmaktayım ve kişilerin randevu tarihleri yaklaştığında kendilerine bir hatırlatma maili atmaktayım ve bunu her seferinde manuel olarak yapıyorum.

Excel'im ekte de göreceğiniz gibi şu şekildedir;

C sütununda hastanın mail adresi, P sütununda mailin gönderileceği tarih ve Z sütununda gönderilmesi gereken metin yer alıyor (verilerin başka bir sayfadan çekilmesi de gerekebiliyor).

İstediğim şey aslında şu;

Örneğin P5 hücresindeki tarih geldiğinde, Z5 hücresindeki metnin, C5 hücresindeki mail adresine otomatik olarak Outlook'taki info@ghospital.com adresinden gönderilmesi (ve eğer mümkünse bunu otomatik olarak yapması, her seferinde bir tuşa basmama gerek olmadan)

Böyle bir şey mümkün müdür?

Vereceğiniz olumlu/olumsuz her türlü cevap için şimdiden teşekkür eder, iyi günler dilerim.
 

Ekli dosyalar

Excel dosyasını her gün bir defa açmanız ve butona basmanız gerekir.
VBA auto_open kullanarak dosya açıldığı gibi mail göndermesini de sağlayabilirsiniz.

Gönderim için '.send in başındaki tırnağı kaldırın.

Kod: 
Sub mail_gonder()
   sonsatir = Cells(Rows.Count, "A").End(3).Row
   For i = 2 To sonsatir
      isim = Cells(i, "B").Value
      mail = Cells(i, "C").Value
      randevutarih = Cells(i, "O").Value
      mailtarihi = CDate(Cells(i, "P").Value)
      If Date = mailtarihi Then
            mesaj = "Sayın " & isim & "," & "<br>" & randevutarihi & " tarihindeki randevunuzu hatırlatmak isteriz. " & "<br>" & "Saygılar."
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
             .To = mail
             .CC = ""
             .Subject = "Randevu Hatırlatma"
             .Display
             
             'Maili otomatik göndermek için .send deki tırnak işaretini kaldırın.
             '.send
             .HTMLBody = mesaj & .HTMLBody
             End With
            
            Set wrdEdit = Nothing
            Set OutMail = Nothing
            Set OutApp = Nothing
      End If
  Next i
  
End Sub
 

Ekli dosyalar

asri' Alıntı:
Excel dosyasını her gün bir defa açmanız ve butona basmanız gerekir.
VBA auto_open kullanarak dosya açıldığı gibi mail göndermesini de sağlayabilirsiniz.

Gönderim için '.send in başındaki tırnağı kaldırın.

Kod: 
Sub mail_gonder()
   sonsatir = Cells(Rows.Count, "A").End(3).Row
   For i = 2 To sonsatir
      isim = Cells(i, "B").Value
      mail = Cells(i, "C").Value
      randevutarih = Cells(i, "O").Value
      mailtarihi = CDate(Cells(i, "P").Value)
      If Date = mailtarihi Then
            mesaj = "Sayın " & isim & "," & "<br>" & randevutarihi & " tarihindeki randevunuzu hatırlatmak isteriz. " & "<br>" & "Saygılar."
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
             .To = mail
             .CC = ""
             .Subject = "Randevu Hatırlatma"
             .Display
             
             'Maili otomatik göndermek için .send deki tırnak işaretini kaldırın.
             '.send
             .HTMLBody = mesaj & .HTMLBody
             End With
            
            Set wrdEdit = Nothing
            Set OutMail = Nothing
            Set OutApp = Nothing
      End If
  Next i
  
End Sub
Genişletmek için tıkla ...

Merhabalar Asri Bey,

Emeğiniz için teşekkür ederim fakat maili gönder dediğimde herhangi bir aksiyon gerçekleşmiyor. (send'teki ' işaretini silerek de denedim). Bir de gönderilecek içeriği Z sütunundan çekmesi benim için daha doğru olacaktır çünkü 2-3 farklı mail taslağı olabiliyor. (Office/Excel 2016 kullanıyorum). Sorunun kaynağı ne olabilir acaba?

Ek soru: mail gönderilme tarihini girerken 22.11.2017 yerine 22.11.2017 08:30 gibi seçmek mümkün müdür sizin yazdığınız kodda?

Saygılar
 
Nilay Karabasogullari' Alıntı:
Merhabalar Asri Bey,

Emeğiniz için teşekkür ederim fakat maili gönder dediğimde herhangi bir aksiyon gerçekleşmiyor. (send'teki ' işaretini silerek de denedim). Bir de gönderilecek içeriği Z sütunundan çekmesi benim için daha doğru olacaktır çünkü 2-3 farklı mail taslağı olabiliyor. (Office/Excel 2016 kullanıyorum). Sorunun kaynağı ne olabilir acaba?

Ek soru: mail gönderilme tarihini girerken 22.11.2017 yerine 22.11.2017 08:30 gibi seçmek mümkün müdür sizin yazdığınız kodda?

Saygılar
Genişletmek için tıkla ...

Sayın Asri'nin kodu üzerinde istediğiniz değişiklikleri yaptım. Saat konusunda bir şey yapamadım.
 

Ekli dosyalar

Kod: 
Sub mail_gonder()
   sonsatir = Cells(Rows.Count, "A").End(3).Row
   For i = 2 To sonsatir
      isim = Cells(i, "B").Value
      mail = Cells(i, "C").Value
      randevutarihi = Cells(i, "O").Value
      mailtarihi = CDate(Cells(i, "P").Value)
      If Format(Now, "dd.mm.yyyy hh:mm") = Format(mailtarihi, "dd.mm.yyyy hh:mm") Then
            mesaj = Cells(i, "Z")
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
             .To = mail
             .CC = ""
             .Subject = "Randevu Hatirlatma"
             .Display
             
             'Maili otomatik göndermek için .send deki tırnak işaretini kaldırın.
             '.send
             .HTMLBody = mesaj & .HTMLBody
             End With
            
            Set wrdEdit = Nothing
            Set OutMail = Nothing
            Set OutApp = Nothing
      End If
  Next i
  
End Sub
 
askm' Alıntı:
Kod: 
Sub mail_gonder()
   sonsatir = Cells(Rows.Count, "A").End(3).Row
   For i = 2 To sonsatir
      isim = Cells(i, "B").Value
      mail = Cells(i, "C").Value
      randevutarihi = Cells(i, "O").Value
      mailtarihi = CDate(Cells(i, "P").Value)
      If Format(Now, "dd.mm.yyyy hh:mm") = Format(mailtarihi, "dd.mm.yyyy hh:mm") Then
            mesaj = Cells(i, "Z")
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
             .To = mail
             .CC = ""
             .Subject = "Randevu Hatirlatma"
             .Display
             
             'Maili otomatik göndermek için .send deki tırnak işaretini kaldırın.
             '.send
             .HTMLBody = mesaj & .HTMLBody
             End With
            
            Set wrdEdit = Nothing
            Set OutMail = Nothing
            Set OutApp = Nothing
      End If
  Next i
  
End Sub
Genişletmek için tıkla ...

Sayın Askm, bu kodu denedim fakat herhangi bir işlem gerçekleşmedi, bilginize.
 
Nilay Karabasogullari' Alıntı:
Sayın Askm, bu kodu denedim fakat herhangi bir işlem gerçekleşmedi, bilginize.
Genişletmek için tıkla ...


* Makro ayarlarına makrolarınız etkin mi?
* Gönderilen dosya üzerinde mi deneme yapıyorsunuz?
* Kodu kendi dosyanıza yapıştırıp mı deneme yapıyorsunuz?


VBA bölümüne geçip mail gönder prosedürü içinde iken F8 ile adım adım çalıştırıp hangi aşamayı atladığını yada kontrol ediniz.
 
Dosyanız ektedir. Bende örnek olarak deneyip kodu ekledim. Çalışıyor.
Hücre biçimlendirmesini Tarih kısmında 14 Mart 2012 13:30 şeklinde yazan şekli ile seçip deneyin. Bir kodu çalıştırdığınız zamanki tarih ve saati yazın. Alt satıra da 1 dakika sonrasını yazın. Sadece ilk satırı alacak. Sonraki satıra işlem yapmayacak.
 
bmutlu966' Alıntı:
Sayın Asri'nin kodu üzerinde istediğiniz değişiklikleri yaptım. Saat konusunda bir şey yapamadım.
Genişletmek için tıkla ...

Merhaba Bmutlu, öncelikle teşekkür ederim. Fakat yazmış olduğunuz kodda bir yanlışlık var sanırım. Göndere bastığımda Outlook yeni mail gönderme sayfası açılıyor, otomatik olarak göndermiyor.

Benim istediğim şuydu aslında;

Exceli açık olduğu sürece vakti gelen kişiye otomatik olarak mail göndermesi, bu mümkün müdür? (tercihen mailin gönderilme saatini de girebileceğim bir şekilde)
 
askm' Alıntı:
Dosyanız ektedir. Bende örnek olarak deneyip kodu ekledim. Çalışıyor.
Hücre biçimlendirmesini Tarih kısmında 14 Mart 2012 13:30 şeklinde yazan şekli ile seçip deneyin. Bir kodu çalıştırdığınız zamanki tarih ve saati yazın. Alt satıra da 1 dakika sonrasını yazın. Sadece ilk satırı alacak. Sonraki satıra işlem yapmayacak.
Genişletmek için tıkla ...

Ek ne yazık ki mevcut değil, tekrar ekleyebilir misiniz?
 
asri' Alıntı:
* Makro ayarlarına makrolarınız etkin mi?
* Gönderilen dosya üzerinde mi deneme yapıyorsunuz?
* Kodu kendi dosyanıza yapıştırıp mı deneme yapıyorsunuz?


VBA bölümüne geçip mail gönder prosedürü içinde iken F8 ile adım adım çalıştırıp hangi aşamayı atladığını yada kontrol ediniz.
Genişletmek için tıkla ...

Makro ayarlarım etkin ve denemeyi sizin göndermiş olduğunuz dosya üzerinden gerçekleştirdim. Sorunu anlamaya çalıştım fakat başarılı olamadım. Neyi yanlış yapıyor olabilirim?
 
Belirttiğiniz gibi dosya açık olduğu sürece kod sürekli çalışması makineyi aşırı şekilde yoracaktır. Eklenen kodlar butona eklenmiş kodlardır.
 
askm' Alıntı:
Belirttiğiniz gibi dosya açık olduğu sürece kod sürekli çalışması makineyi aşırı şekilde yoracaktır. Eklenen kodlar butona eklenmiş kodlardır.
Genişletmek için tıkla ...

Peki bu mümkün müdür? (yorulması sorun değil) Yeni göndermiş olduğunuz kodu tekrar denedim. Minik bir hata var sanırım, eğer 3. satırdaki mail gönderme tarihine şimdiki tarihi yazarsam göndermiyor (illa 1. satırda yazmalı gibi bir sorun var galiba). Yani ben bunu her dakika tıklamalı mıyım anlamadım? Ben sabahleyin bu dosyayı açmanın yeterli olacağı bir yöntem varsa eğer onu uygulamayı amaçlıyordum, ama eğer sık sık maili gönder butonuna basmam gerekecekse bunun bana pek faydası olmayacaktır sanırım.
 
askm' Alıntı:
Bunun yerine çözüm olarak şunu önereyim. Sabah açınca o günkü tarihli olanları süzsün onlara mail atsın.
Saat olayı için de http://www.vbforums.com/showthread.php?574491-RESOLVED-Outlook-VB-Macro-Deffered-Delivery-Time linkini bir inceleyin.
Genişletmek için tıkla ...

Sayın askm,

Göndermiş olduğunuz linkteki açıklama çok güzel, keşke onu kendi Excel dosyama uygun hale getirebilecek makro bilgisine sahip olsam, fakat ne yazık ki değilim..

Sizin sunmuş olduğunuz "Sabah açınca o günkü tarihli olanları süzsün onlara mail atsın." çözümü de benim işimi görür (eğer butona tıkladığımda otomatik olarak mailler gidecek ise). Bu şekilde bir ek dosya gönderebilir misiniz?

Saygılar
 
Kodları aşağıdaki ile değiştirin. Kaydedin. Kapatıp açın. Exceli her açtığınızda makro otomatik çalışacaktır. X sütununda mail atıldı yazılanlara mail atmayacaktır. (Bu sütunu değiştirebilirsiniz.) Eğer yazılı değilse açılışta otomatik tarihi aynı olanlara mail atacaktır.
Kod: 
Sub Auto_Open()
Call mail_gonder
End Sub


Sub mail_gonder()
   sonsatir = Cells(Rows.Count, "A").End(3).Row
   On Error Resume Next
   For i = 2 To sonsatir
if  Cells(i, "X").Value<>"Mail atıldı" then
      isim = Cells(i, "B").Value
      Mail = Cells(i, "C").Value
      randevutarihi = Cells(i, "O").Value
      mailtarihi = CDate(Cells(i, "P").Value)
      If Format(Now, "dd.mm.yyyy") = Format(mailtarihi, "dd.mm.yyyy") Then
            mesaj = Cells(i, "Z")
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
             .To = Mail
             .CC = ""
             .Subject = "Randevu Hatirlatma"
             .Display
             
             'Maili otomatik göndermek için .send deki tırnak işaretini kaldırın.
             '.send
             .HTMLBody = mesaj & .HTMLBody
             End With
            
            Set wrdEdit = Nothing
            Set OutMail = Nothing
            Set OutApp = Nothing
      End If
 Cells(i, "X").Value="Mail atıldı"
end if
  Next i
  
End Sub
 
askm' Alıntı:
Kodları aşağıdaki ile değiştirin. Kaydedin. Kapatıp açın. Exceli her açtığınızda makro otomatik çalışacaktır. X sütununda mail atıldı yazılanlara mail atmayacaktır. (Bu sütunu değiştirebilirsiniz.) Eğer yazılı değilse açılışta otomatik tarihi aynı olanlara mail atacaktır.
Kod: 
Sub Auto_Open()
Call mail_gonder
End Sub


Sub mail_gonder()
   sonsatir = Cells(Rows.Count, "A").End(3).Row
   On Error Resume Next
   For i = 2 To sonsatir
if  Cells(i, "X").Value<>"Mail atıldı" then
      isim = Cells(i, "B").Value
      Mail = Cells(i, "C").Value
      randevutarihi = Cells(i, "O").Value
      mailtarihi = CDate(Cells(i, "P").Value)
      If Format(Now, "dd.mm.yyyy") = Format(mailtarihi, "dd.mm.yyyy") Then
            mesaj = Cells(i, "Z")
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
             .To = Mail
             .CC = ""
             .Subject = "Randevu Hatirlatma"
             .Display
             
             'Maili otomatik göndermek için .send deki tırnak işaretini kaldırın.
             '.send
             .HTMLBody = mesaj & .HTMLBody
             End With
            
            Set wrdEdit = Nothing
            Set OutMail = Nothing
            Set OutApp = Nothing
      End If
 Cells(i, "X").Value="Mail atıldı"
end if
  Next i
  
End Sub
Genişletmek için tıkla ...

Sayın askm,

Teşekkür ederim Excel'e girdiğim anda direkt o günküleri süzüyor fakat maili otomatik göndermek yerine mail gönderme ekranını açıyor. Otomatik olarak göndermesini de sağlamak mümkün müdür?

Not: X sütunu ile ilgili belirttiğinizi tam olarak anlayamadım (anlamak için çaba gösterdim:)
 
'.send başındaki tek tırnağı kaldırın. .Display kısmının başınatek tırnak ekleyin.
 
Aşağıdaki gibi düzelttim fakat maili otomatik olarak göndermedi..

Kod: 
Sub Auto_Open()
Call mail_gonder
End Sub


Sub mail_gonder()
   sonsatir = Cells(Rows.Count, "A").End(3).Row
   On Error Resume Next
   For i = 2 To sonsatir
If Cells(i, "X").Value <> "Mail atıldı" Then
      isim = Cells(i, "B").Value
      Mail = Cells(i, "C").Value
      randevutarihi = Cells(i, "O").Value
      mailtarihi = CDate(Cells(i, "P").Value)
      If Format(Now, "dd.mm.yyyy") = Format(mailtarihi, "dd.mm.yyyy") Then
            mesaj = Cells(i, "Z")
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
             .To = Mail
             .CC = ""
             .Subject = "Randevu Hatirlatma"
             '.Display
             
             'Maili otomatik göndermek için .send deki tırnak işaretini kaldırın.
             .send
             .HTMLBody = mesaj & .HTMLBody
             End With
            
            Set wrdEdit = Nothing
            Set OutMail = Nothing
            Set OutApp = Nothing
      End If
 Cells(i, "X").Value = "Mail atıldı"
End If
  Next i
  
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst