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
Sorgudaki Bilgileri Otomatik Tek Tek Mail Gönderme
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=r...order=desc
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=r...order=desc
İyi olan tek şey bilgi ve kötü olan tek şey de cehalettir. (Sokrates)
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
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.
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.
Son Düzenleme: 09/11/2024, 17:06, Düzenleyen: cirdakc.
SendMail fonksiyonunuzu aşağıdaki gibi değiştirin
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
https://security.google.com/settings/sec...ppasswords 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.
(09/11/2024, 21:17)atoykan yazdı: SendMail fonksiyonunuzu aşağıdaki gibi değiştirin
https://security.google.com/settings/sec...ppasswords 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ı.
Konuyu Okuyanlar: 1 Ziyaretçi