• 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

askm' Alıntı:
Döngünün başında mesaj="" şeklinde mesaj içeriğini boşaltın.
Diğer konu için de aynı şekilde bu sefer w hücresini kontrol ederek kod yazın. Mail 2 gibi. Auto kısmına onun adını da ekleyin.
Genişletmek için tıkla ...

İlk konuyu halledebildim askm, fakat doğum günü konusunu halledemedim. Ben 2017'de de 2018'de de 2019'da da vs. doğum günün mailinin her sene ilgili kişiye gitmesini istiyorum. Armut piş ağzıma düş modunda değilim size yazmadan önce kendi başıma halletmeye çalışıyorum :) fakat kodu bu şekilde düzenlemede başarılı olamadım. Yardımcı olur musunuz lütfen?
 
Doğum tarihi olan bir örnek tablo ekleyin bakalım.
 
Kod: 
Sub mail_gonder()
   sonsatir = Cells(Rows.Count, "A").End(3).Row
   On Error Resume Next
   For i = 2 To sonsatir
If Cells(i, "AS").Value <> "Mail atıldı" Then

      isim = Cells(i, "B").Value
      Mail = Cells(i, "C").Value
      randevutarihi = Cells(i, "Q").Value
      mailtarihi = CDate(Cells(i, "T").Value)
If Format(Now, "dd.mm.yyyy") = Format(mailtarihi, "dd.mm.yyyy") Then
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

      If Cells(i, "R") = "Örnek alımı" And Cells(i, "S") = "Evet" Then
        Mesaj = "Sayın" & " " & Cells(i, "B") & "," & _
             "<BR>" & _
             "<BR>" & " " & Format(Cells(i, "Q"), "dd/mm/yyyy hh:mm") & " " & "tarihinde gerçekleşecek olan örnek alımınızı hatırlatmak için yazıyoruz. Akşam saat 20:00'dan itibaren su hariç bir şey yiyip içmeyiniz, cinsel temasta bulunmayınız, yoğun spor yapmayınız, hamam ve saunaya girmeyiniz. Kullanmakta olduğunuz ilaçları alabilirsiniz. Besin desteklerinizi kullanmayınız." & _
            "<BR>" & _
            "<BR>" & "Saygılar," & "<BR>" & _
            "<BR>" & "g.e" & _
            "<BR>" & "0212"
      ElseIf Cells(i, "R") = "Örnek alımı" And Cells(i, "S") = "Hayır" Then
        Mesaj = "Sayın" & " " & Cells(i, "B") & "," & _
             "<BR>" & _
             "<BR>" & " " & Format(Cells(i, "Q"), "dd/mm/yyyy hh:mm") & " " & "tarihinde gerçekleşecek olan örnek alımınızı hatırlatmak için yazıyoruz. Akşam saat 20:00'dan itibaren su hariç bir şey yiyip içmeyiniz. Kullanmakta olduğunuz ilaçları alabilirsiniz. Besin desteklerinizi kullanmayınız." & _
            "<BR>" & _
            "<BR>" & "Saygılar," & "<BR>" & _
            "<BR>" & "g.e" & _
            "<BR>" & "0212"
        ElseIf Cells(i, "R") = "Rapor yorumu" Then
            Mesaj = "Sayın" & " " & Cells(i, "B") & "," & _
             "<BR>" & _
             "<BR>" & " " & Format(Cells(i, "Q"), "dd/mm/yyyy hh:mm") & " " & "tarihinde gerçekleşecek olan rapor yorumunuzu hatırlatmak için yazıyoruz. Görüşmeniz yaklaşık olarak 4 saat sürecektir. Görüşmeye 15 dakikadan fazla geç kalmanız durumunda, sizden sonra başka bir danışan randevusu var ise, randevunuz iptal edilebilir. Lütfen randevunuzu onaylamak veya programınızda herhangi bir değişiklik varsa bu maile yanıt olarak veya aşağıdaki telefon numarasından haberdar ediniz." & _
            "<BR>" & _
            "<BR>" & "Saygılar," & "<BR>" & _
            "<BR>" & "g.e" & _
            "<BR>" & "0212"
        ElseIf Cells(i, "R") = "Kontrol görüşmesi" Then
            Mesaj = "Sayın" & " " & Cells(i, "B") & "," & _
             "<BR>" & _
             "<BR>" & " " & Format(Cells(i, "Q"), "dd/mm/yyyy hh:mm") & " " & "tarihinde gerçekleşecek olan kontrol görüşmenizi yorumunuzu hatırlatmak için yazıyoruz. Görüşmeniz yaklaşık olarak 2 saat sürecektir. Görüşmeye 15 dakikadan fazla geç kalmanız durumunda, sizden sonra başka bir danışan randevusu var ise, randevunuz iptal edilebilir. Lütfen randevunuzu onaylamak veya programınızda herhangi bir değişiklik varsa bu maile yanıt olarak veya aşağıdaki telefon numarasından haberdar ediniz." & _
            "<BR>" & _
            "<BR>" & "Saygılar," & "<BR>" & _
            "<BR>" & "g.e" & _
            "<BR>" & "0212"
        ElseIf Cells(i, "R") = "Radar görüşmesi" Then
            Mesaj = "Sayın" & " " & Cells(i, "B") & "," & _
             "<BR>" & _
             "<BR>" & " " & Format(Cells(i, "Q"), "dd/mm/yyyy hh:mm") & " " & "tarihinde gerçekleşecek olan radar görüşmenizi yorumunuzu hatırlatmak için yazıyoruz. Görüşmeniz yaklaşık olarak 1,5 saat sürecektir. Görüşmeye 15 dakikadan fazla geç kalmanız durumunda, sizden sonra başka bir danışan randevusu var ise, randevunuz iptal edilebilir. Lütfen randevunuzu onaylamak veya programınızda herhangi bir değişiklik varsa bu maile yanıt olarak veya aşağıdaki telefon numarasından haberdar ediniz." & _
            "<BR>" & _
            "<BR>" & "Saygılar," & "<BR>" & _
            "<BR>" & "g.e" & _
            "<BR>" & "0212"
        ElseIf Cells(i, "R") = "" Then
           Mesaj = "Sayın" & " " & Cells(i, "B") & "," & _
             "<BR>" & _
             "<BR>" & " " & Format(Cells(i, "Q"), "dd/mm/yyyy hh:mm") & " " & "tarihinde gerçekleşecek olan randevunuzu hatırlatmak için yazıyoruz. Lütfen randevunuzu onaylamak veya programınızda herhangi bir değişiklik varsa bu maile yanıt olarak veya aşağıdaki telefon numarasından haberdar ediniz." & _
            "<BR>" & _
            "<BR>" & "Saygılar," & "<BR>" & _
            "<BR>" & "g.e" & _
            "<BR>" & "0212"
      End If
      
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'            Mesaj = Cells(i, "M")
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
             .To = Mail
             .CC = ""
             .Subject = "Randevu Hatirlatma"
              .HTMLBody = Mesaj & .HTMLBody
             'Maili otomatik göndermek için .send deki tırnak işaretini kaldırın.
             '.Display
             .send
         
             End With
            
            Set wrdEdit = Nothing
            Set OutMail = Nothing
            Set OutApp = Nothing
      
 Cells(i, "AS").Value = "Mail atıldı"
End If

If Cells(i, "AT").Value = "" Then
If Format(Now, "dd.mm.yyyy") = Format(DateSerial(Year(Now), Month(Cells(i, "W")), Day(Cells(i, "W"))), "dd.mm.yyyy") Then
     Mesaj = "Sayın" & " " & Cells(i, "B") & "," & _
             "<BR>" & "Doğum gününüz kutlu olsun..."
     
     Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
             .To = Mail
             .CC = ""
             .Subject = "Randevu Hatirlatma"
              .HTMLBody = Mesaj & .HTMLBody
             'Maili otomatik göndermek için .send deki tırnak işaretini kaldırın.
             .Display
             '.send
         
             End With
            
            Set wrdEdit = Nothing
            Set OutMail = Nothing
            Set OutApp = Nothing
            Cells(i, "AT").Value = "Doğum günü kutlandı"
End If
End If
End If
Next i
  
End Sub
 
askm' Alıntı:
Kod: 
Sub mail_gonder()
   sonsatir = Cells(Rows.Count, "A").End(3).Row
   On Error Resume Next
   For i = 2 To sonsatir
If Cells(i, "AS").Value <> "Mail atıldı" Then

      isim = Cells(i, "B").Value
      Mail = Cells(i, "C").Value
      randevutarihi = Cells(i, "Q").Value
      mailtarihi = CDate(Cells(i, "T").Value)
If Format(Now, "dd.mm.yyyy") = Format(mailtarihi, "dd.mm.yyyy") Then
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

      If Cells(i, "R") = "Örnek alımı" And Cells(i, "S") = "Evet" Then
        Mesaj = "Sayın" & " " & Cells(i, "B") & "," & _
             "<BR>" & _
             "<BR>" & " " & Format(Cells(i, "Q"), "dd/mm/yyyy hh:mm") & " " & "tarihinde gerçekleşecek olan örnek alımınızı hatırlatmak için yazıyoruz. Akşam saat 20:00'dan itibaren su hariç bir şey yiyip içmeyiniz, cinsel temasta bulunmayınız, yoğun spor yapmayınız, hamam ve saunaya girmeyiniz. Kullanmakta olduğunuz ilaçları alabilirsiniz. Besin desteklerinizi kullanmayınız." & _
            "<BR>" & _
            "<BR>" & "Saygılar," & "<BR>" & _
            "<BR>" & "g.e" & _
            "<BR>" & "0212"
      ElseIf Cells(i, "R") = "Örnek alımı" And Cells(i, "S") = "Hayır" Then
        Mesaj = "Sayın" & " " & Cells(i, "B") & "," & _
             "<BR>" & _
             "<BR>" & " " & Format(Cells(i, "Q"), "dd/mm/yyyy hh:mm") & " " & "tarihinde gerçekleşecek olan örnek alımınızı hatırlatmak için yazıyoruz. Akşam saat 20:00'dan itibaren su hariç bir şey yiyip içmeyiniz. Kullanmakta olduğunuz ilaçları alabilirsiniz. Besin desteklerinizi kullanmayınız." & _
            "<BR>" & _
            "<BR>" & "Saygılar," & "<BR>" & _
            "<BR>" & "g.e" & _
            "<BR>" & "0212"
        ElseIf Cells(i, "R") = "Rapor yorumu" Then
            Mesaj = "Sayın" & " " & Cells(i, "B") & "," & _
             "<BR>" & _
             "<BR>" & " " & Format(Cells(i, "Q"), "dd/mm/yyyy hh:mm") & " " & "tarihinde gerçekleşecek olan rapor yorumunuzu hatırlatmak için yazıyoruz. Görüşmeniz yaklaşık olarak 4 saat sürecektir. Görüşmeye 15 dakikadan fazla geç kalmanız durumunda, sizden sonra başka bir danışan randevusu var ise, randevunuz iptal edilebilir. Lütfen randevunuzu onaylamak veya programınızda herhangi bir değişiklik varsa bu maile yanıt olarak veya aşağıdaki telefon numarasından haberdar ediniz." & _
            "<BR>" & _
            "<BR>" & "Saygılar," & "<BR>" & _
            "<BR>" & "g.e" & _
            "<BR>" & "0212"
        ElseIf Cells(i, "R") = "Kontrol görüşmesi" Then
            Mesaj = "Sayın" & " " & Cells(i, "B") & "," & _
             "<BR>" & _
             "<BR>" & " " & Format(Cells(i, "Q"), "dd/mm/yyyy hh:mm") & " " & "tarihinde gerçekleşecek olan kontrol görüşmenizi yorumunuzu hatırlatmak için yazıyoruz. Görüşmeniz yaklaşık olarak 2 saat sürecektir. Görüşmeye 15 dakikadan fazla geç kalmanız durumunda, sizden sonra başka bir danışan randevusu var ise, randevunuz iptal edilebilir. Lütfen randevunuzu onaylamak veya programınızda herhangi bir değişiklik varsa bu maile yanıt olarak veya aşağıdaki telefon numarasından haberdar ediniz." & _
            "<BR>" & _
            "<BR>" & "Saygılar," & "<BR>" & _
            "<BR>" & "g.e" & _
            "<BR>" & "0212"
        ElseIf Cells(i, "R") = "Radar görüşmesi" Then
            Mesaj = "Sayın" & " " & Cells(i, "B") & "," & _
             "<BR>" & _
             "<BR>" & " " & Format(Cells(i, "Q"), "dd/mm/yyyy hh:mm") & " " & "tarihinde gerçekleşecek olan radar görüşmenizi yorumunuzu hatırlatmak için yazıyoruz. Görüşmeniz yaklaşık olarak 1,5 saat sürecektir. Görüşmeye 15 dakikadan fazla geç kalmanız durumunda, sizden sonra başka bir danışan randevusu var ise, randevunuz iptal edilebilir. Lütfen randevunuzu onaylamak veya programınızda herhangi bir değişiklik varsa bu maile yanıt olarak veya aşağıdaki telefon numarasından haberdar ediniz." & _
            "<BR>" & _
            "<BR>" & "Saygılar," & "<BR>" & _
            "<BR>" & "g.e" & _
            "<BR>" & "0212"
        ElseIf Cells(i, "R") = "" Then
           Mesaj = "Sayın" & " " & Cells(i, "B") & "," & _
             "<BR>" & _
             "<BR>" & " " & Format(Cells(i, "Q"), "dd/mm/yyyy hh:mm") & " " & "tarihinde gerçekleşecek olan randevunuzu hatırlatmak için yazıyoruz. Lütfen randevunuzu onaylamak veya programınızda herhangi bir değişiklik varsa bu maile yanıt olarak veya aşağıdaki telefon numarasından haberdar ediniz." & _
            "<BR>" & _
            "<BR>" & "Saygılar," & "<BR>" & _
            "<BR>" & "g.e" & _
            "<BR>" & "0212"
      End If
      
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'            Mesaj = Cells(i, "M")
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
             .To = Mail
             .CC = ""
             .Subject = "Randevu Hatirlatma"
              .HTMLBody = Mesaj & .HTMLBody
             'Maili otomatik göndermek için .send deki tırnak işaretini kaldırın.
             '.Display
             .send
         
             End With
            
            Set wrdEdit = Nothing
            Set OutMail = Nothing
            Set OutApp = Nothing
      
 Cells(i, "AS").Value = "Mail atıldı"
End If

If Cells(i, "AT").Value = "" Then
If Format(Now, "dd.mm.yyyy") = Format(DateSerial(Year(Now), Month(Cells(i, "W")), Day(Cells(i, "W"))), "dd.mm.yyyy") Then
     Mesaj = "Sayın" & " " & Cells(i, "B") & "," & _
             "<BR>" & "Doğum gününüz kutlu olsun..."
     
     Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
             .To = Mail
             .CC = ""
             .Subject = "Randevu Hatirlatma"
              .HTMLBody = Mesaj & .HTMLBody
             'Maili otomatik göndermek için .send deki tırnak işaretini kaldırın.
             .Display
             '.send
         
             End With
            
            Set wrdEdit = Nothing
            Set OutMail = Nothing
            Set OutApp = Nothing
            Cells(i, "AT").Value = "Doğum günü kutlandı"
End If
End If
End If
Next i
  
End Sub
Genişletmek için tıkla ...

Denedim sorunsuz bir şekilde çalışıyor, teşekkür ederim!
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst