| 
 Sorgudaki Bilgileri Otomatik Tek Tek Mail Gönderme - cirdakc -  08/11/2024
 
 Sayın Hocalarım;
 
 Accees üzerinden mail adresi bilgilerimi tanımlayarak Üye Datası Sorgusunda yer alan her üyenin verisini otomatik tek tek aşağıdaki şekilde üyelere mail olarak göndermek istiyorum. Kendi çalışmamı eklere yükledim bir tane tane örnek buldum onun formu çok güzel onu da çözemedim.
 
 Konuyu hiç bir alanda çözemedim yardımlarınızı bekliyorum.
 
 Mail İçeriği
 
 Sayın üyemiz aidat bilgileriniz aşağıda yer almaktadır.
 
 Dönem : Sorgudaki Ay
 Tahakkuk : Sorgudaki Tahakkuk
 Tahsilat: Sorgudaki Tahsilat
 Kalan Borc : Sorgudaki Borc
 
 
 RE: Sorgudaki Bilgileri Otomatik Tek Tek Mail Gönderme - onur_can -  08/11/2024
 
 eklemiş olduğunuz uygulamada(sizin) hiç mail gönderme çalışması yok, çözemediğin uygulamada ise hiç tablo yok, tablo yoksa uygulamada yok sayılır.
 Size bilgi vermesi açısından, bir ışık tutması açısından formumuzda bulunan Mail Gönderme ile ilgili sonuçları gösteren linki ekliyorum. Umarım faydalı olur...
 https://accesstr.net/search.php?action=results&sid=e6156f10991a325066cac2697141f901&sortby=lastpost&order=desc
 
 
 RE: Sorgudaki Bilgileri Otomatik Tek Tek Mail Gönderme - atoykan -  09/11/2024
 
 Sayın @onur_can hocamızın belirttiği üzere örneklerinizde değerlendirme yapmamızı ve çözüm önerisi sunmamızı gerektiren asli unsurlar yok. Ancak örnek tablonuzdan yola çıkarak sorgu sonuçlarını göndermek istediğiniz kişilerin mail adresleri ve diğer bilgilerinin tutulduğu cari kart verilerini içeren bir tablo oluşturmanız, sorgunuza bu tablodan email adreslerini dahil etmeniz doğru bir yaklaşım olacaktır ve buna göre örnek olarak aşağıdaki kod sorgunuzun sonuçlarını her bir kayıt için mail olarak gönderilmesini sağlayacaktır.
 
 Sub SendMails()Dim ObjOutlook As Object, ObjMail As Object
 Dim db As DAO.Database
 Dim rst As DAO.Recordset
 
 Set db = CurrentDb()
 Set rst = db.OpenRecordset("SorguAdınz")    'Recordseti tanımla
 
 On Error Resume Next
 Set ObjOutlook = CreateObject("Outlook.Application")
 On Error GoTo 0
 
 If ObjOutlook Is Nothing Then
 MsgBox "Outlook başlatılamadı. Lütfen Outlook'un yüklü ve açık olduğundan emin olun.", vbExclamation    'Outlook başlatılamazsa uyar (bunu genelde kullanmam ama geçen başka bir soruda önerilmiş mantıklı bulduğum için ekledim)
 Exit Sub
 End If
 
 Do Until rst.EOF    'Recordsetin son kaydına kadar kayıtları dolaş
 Set ObjMail = ObjOutlook.CreateItem(0)    'Yeni bir email oluşturur
 
 With ObjMail
 .To = "[AlıcıEpostaAdresi]"    'Alıcı e-posta adresi, sorgunuza ekleyeceğiniz mail alanını değişken olarak kullanabilirsiniz
 .Subject = "Üye Borç Bilgilendirmesi - " & rst!uyeno    'Email konusu (örneğin üye 1 için veya adı soyadını değişken olarak kullanabilirsiniz)
 .Body = "Sayın " & rst![adı soyadı] & "," & vbCrLf & vbCrLf & _
 "Borç bilgilendirmeniz aşağıdaki gibidir:" & vbCrLf & _
 "Ay: " & rst!ay & vbCrLf & _
 "Tahakkuk: " & rst!tahakkuk & vbCrLf & _
 "Tahsilat: " & rst!tahsilat & vbCrLf & _
 "Borç: " & rst!borc & vbCrLf & vbCrLf & _
 "İyi günler dileriz."    'Emailin mesaj içeriği
 .Send    'Emaili gönder
 End With
 
 rst.MoveNext    'sonraki kayda geç
 Loop
 
 rst.Close
 Set rst = Nothing
 Set db = Nothing
 Set ObjMail = Nothing
 Set ObjOutlook = Nothing
 
 'MsgBox "E-postalar başarıyla gönderildi.", vbInformation, "Email Gönderim Sonuç Bildirimi"    '(istenirse) işlem bittiğine dair mesaj göster
 End Sub
 
 
 
 RE: Sorgudaki Bilgileri Otomatik Tek Tek Mail Gönderme - cirdakc -  09/11/2024
 
 Değerli hocalarım örneğimi tam olarak hazırladım TOPLU_MAİL formu ile alt formdaki her üyenin verisini üyelere tek tek göndermesini tasarladım lakin çalışmıyor.
 
 deneme.com - deneme@deneme.com mail uzantısı ile denedim olmadı şuan örnekte GMAİL üzerinden göndermeyi deniyorum 2 aşamalı doğrulamada açık.
 
 Yardımlarınızı bekliyorum.
 
 
 RE: Sorgudaki Bilgileri Otomatik Tek Tek Mail Gönderme - atoykan -  09/11/2024
 
 SendMail fonksiyonunuzu aşağıdaki gibi değiştirin
 
 https://security.google.com/settings/security/apppasswords linki üzerinden Google uygulama şifrenizi oluşturun ve mail şifreniz yerine bu şifreyi girin. Referanslardan Microsoft CDO for Windows Library'nin etkin olduğundan emin olun. Ardından mail gönderebilirsiniz.Function SendMail()Dim db As DAO.Database
 Dim rs As DAO.Recordset
 Dim sayac As Integer
 Dim iMsg As Object, iConf As Object, Fields As Object
 Dim iConfURL As String
 
 On Error GoTo hata
 
 Set db = CurrentDb
 Set rs = db.OpenRecordset("EPOSTA")
 
 Do While Not rs.EOF
 Set iMsg = CreateObject("CDO.Message")
 Set iConf = CreateObject("CDO.Configuration")
 
 iConfURL = "http://schemas.microsoft.com/cdo/configuration/"
 
 With iConf.Fields
 .Item(iConfURL & "sendusing") = 2
 .Item(iConfURL & "smtpserver") = "smtp.gmail.com"
 .Item(iConfURL & "smtpserverport") = 465
 .Item(iConfURL & "smtpusessl") = True
 .Item(iConfURL & "smtpauthenticate") = 1
 .Item(iConfURL & "sendusername") = Me.txtmailadresi
 .Item(iConfURL & "sendpassword") = Me.txtmailsifre
 .Update
 End With
 
 With iMsg
 Set .Configuration = iConf
 .To = rs("EMAIL")
 .From = Me.txtGonderen & " <" & Me.txtmailadresi & ">"
 .Subject = Me.TxtKonu
 .TextBody = "TARİH: " & rs("TARIH") & vbCrLf & _
 "AİDAT TAHAKKUK: " & rs("ATAHSILAT") & vbCrLf & _
 "AİDAT TAHSİLAT: " & rs("ATAHAKKUK") & vbCrLf & _
 "AİDAT BORC: " & rs("ABORC")
 End With
 
 iMsg.Send
 
 sayac = sayac + 1
 Me.Metin31 = sayac & ". Mail Gönderildi."
 rs.MoveNext
 Loop
 
 MsgBox sayac & " mail gönderimi başarılı.", vbInformation, "İşlem tamam"
 
 Set iMsg = Nothing
 Set iConf = Nothing
 Set Fields = Nothing
 rs.Close
 Set rs = Nothing
 
 Exit Function
 
 hata:
 MsgBox "Mail gönderimi başarısız. Hata: " & Err.Description, vbCritical, "Hata oluştu."
 Debug.Print "CDO Hatası: " & Err.Description
 End Function
 
 
 
 RE: Sorgudaki Bilgileri Otomatik Tek Tek Mail Gönderme - cirdakc -  09/11/2024
 
 
  (09/11/2024, 21:17)atoykan yazdı:  SendMail fonksiyonunuzu aşağıdaki gibi değiştirin
 https://security.google.com/settings/security/apppasswords linki üzerinden Google uygulama şifrenizi oluşturun ve mail şifreniz yerine bu şifreyi girin. Referanslardan Microsoft CDO for Windows Library'nin etkin olduğundan emin olun. Ardından mail gönderebilirsiniz.Function SendMail()Dim db As DAO.Database
 Dim rs As DAO.Recordset
 Dim sayac As Integer
 Dim iMsg As Object, iConf As Object, Fields As Object
 Dim iConfURL As String
 
 On Error GoTo hata
 
 Set db = CurrentDb
 Set rs = db.OpenRecordset("EPOSTA")
 
 Do While Not rs.EOF
 Set iMsg = CreateObject("CDO.Message")
 Set iConf = CreateObject("CDO.Configuration")
 
 iConfURL = "http://schemas.microsoft.com/cdo/configuration/"
 
 With iConf.Fields
 .Item(iConfURL & "sendusing") = 2
 .Item(iConfURL & "smtpserver") = "smtp.gmail.com"
 .Item(iConfURL & "smtpserverport") = 465
 .Item(iConfURL & "smtpusessl") = True
 .Item(iConfURL & "smtpauthenticate") = 1
 .Item(iConfURL & "sendusername") = Me.txtmailadresi
 .Item(iConfURL & "sendpassword") = Me.txtmailsifre
 .Update
 End With
 
 With iMsg
 Set .Configuration = iConf
 .To = rs("EMAIL")
 .From = Me.txtGonderen & " <" & Me.txtmailadresi & ">"
 .Subject = Me.TxtKonu
 .TextBody = "TARİH: " & rs("TARIH") & vbCrLf & _
 "AİDAT TAHAKKUK: " & rs("ATAHSILAT") & vbCrLf & _
 "AİDAT TAHSİLAT: " & rs("ATAHAKKUK") & vbCrLf & _
 "AİDAT BORC: " & rs("ABORC")
 End With
 
 iMsg.Send
 
 sayac = sayac + 1
 Me.Metin31 = sayac & ". Mail Gönderildi."
 rs.MoveNext
 Loop
 
 MsgBox sayac & " mail gönderimi başarılı.", vbInformation, "İşlem tamam"
 
 Set iMsg = Nothing
 Set iConf = Nothing
 Set Fields = Nothing
 rs.Close
 Set rs = Nothing
 
 Exit Function
 
 hata:
 MsgBox "Mail gönderimi başarısız. Hata: " & Err.Description, vbCritical, "Hata oluştu."
 Debug.Print "CDO Hatası: " & Err.Description
 End Function
 
 Hocam çok teşekkür ederim elinize aklınıza sağlık sorunsuz çalıştı.
 
 
 
 |