Daha kolay olması için, unvan seçip mail gönderme işini ayrı bir formda yaptım.
Bir deneyin bakalım, sizde problemsiz çalışacak mı?
Private Sub btn_EPOSTA_Click()
On Error GoTo Hata
'---------------------------------------------------------------
Dim DB As DAO.Database, RS As DAO.Recordset
Dim objMessage As Object
Dim SMTP_Sunucu, strBody
Dim Kullanicinin_Adi, Kullanicinin_Mail_Adresi, Kullanicinin_Mail_Sifresi
Dim TalepEdenin_Adi, TalepEdenin_Mail_Adresi
Const cdoAnonymous = 0
Const cdoBasic = 1
Const cdoNTLM = 2
'---------------------------------------------------------------
' Buraya kendi mail bilgilerinizi girmeniz gerekiyor.
' İsterseniz bir tablodan veya formdan sorarak alabilirsiniz
'---------------------------------------------------------------
SMTP_Sunucu = "smtp.bline.net.tr"
Kullanicinin_Adi = "Adı ve Soyadı"
Kullanicinin_Mail_Adresi = "mail adresiniz"
Kullanicinin_Mail_Sifresi = "Mail şifreniz"
'---------------------------------------------------------------
Set DB = CurrentDb()
'Set RS = DB.OpenRecordset(Me.Personel_Listesi.RowSource, dbOpenForwardOnly)
Set RS = DB.OpenRecordset("Select * From Personel Where unvan Like '" & Forms![E-Posta]!Secilen_Unvan & "*'", dbOpenForwardOnly)
Set objMessage = CreateObject("CDO.Message")
Do While Not RS.EOF
'---------------------------------------------------------------
' Okunan kayıttaki kişi için mail bilgileri oluşturuluyor ve gönderiliyor
'---------------------------------------------------------------
strBody = "Sn. " & RS.Fields("adi") & " " & RS.Fields("soyadi")
strBody = strBody & " gönderilecek metni buraya yazın"
'---------
objMessage.Subject = "Deneme Maili"
objMessage.From = Kullanicinin_Adi & "<" & Kullanicinin_Mail_Adresi & ">"
objMessage.To = RS.Fields("email")
objMessage.HTMLBody = strBody
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Kullanicinin_Mail_Adresi
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Kullanicinin_Mail_Sifresi
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTP_Sunucu
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
objMessage.Configuration.Fields.Update
objMessage.Send
'---------------------------------------------------------------
RS.MoveNext
Loop
RS.Close
Set RS = Nothing
MsgBox "İlgili kişi(lere) e-posta gönderilmiştir.", vbInformation, "İşlem tamam"
Exit Sub
'---------------------------------------------------------------
Hata:
MsgBox "E-posta gönderimi başarısız oldu!", vbCritical, "Hata oluştu."
MsgBox Err.Number & ":" & Err.Description
End Sub
