Sorgudaki Bilgileri Otomatik Tek Tek Mail Gönderme

(09/11/2024, 21:49)cirdakc yazdı:

(09/11/2024, 21:17)atoykan yazdı: 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.

Hocam çok teşekkür ederim elinize aklınıza sağlık sorunsuz çalıştı.