Liste kutusundan gmail ile toplu mail göndermek istiyorum.
İletilecek mail adreslerini ve mail metnini liste kutusundan,
Gönderilen mail adresini, şifreyi, konuyu metin kutusundan alıyor.
Aşağıdaki kodları denediğimde mail gönderiliyor ancak liste kutusundaki tüm alanlar seçili olmasına rağmen sadece birine gönderiliyor.
Acaba nerede eksiklik var.
Cevabınızı beklerim.
Saygılarımla.
Private Sub Komut13_Click()
If (IsNull(txtgmailadresi)) Or (IsNull(txtgmailsifre)) Or (IsNull(Liste1.Column(3))) Or (IsNull(txtKonu)) Or (IsNull(Liste1.Column(1))) Then
MsgBox "Tüm alanları eksiksiz olarak doldurmanız gerekmektedir kontrol edip tekrar deneyiniz!! ", vbCritical + vbOKOnly, "Eksik Bırakılan Alan !!!"
Exit Sub
Else
SendMail
MsgBox "Mailiniz Başarı İle Gönderildi..", vbOKOnly, "Durum Bilgiisi..!!!"
End If
End Sub
Function SendMail()
Dim iMsg, iConf, Flds, schema
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
schema = "http://schemas.microsoft.com/cdo/configuration/"
Flds.Item(schema & "sendusing") = 2
Flds.Item(schema & "smtpserver") = "smtp.gmail.com"
Flds.Item(schema & "smtpserverport") = 465
Flds.Item(schema & "smtpauthenticate") = 1
Flds.Item(schema & "sendusername") = txtgmailadresi
Flds.Item(schema & "sendpassword") = txtgmailsifre
Flds.Item(schema & "smtpusessl") = 1
Flds.Update
With iMsg
.To = Me.Liste1.Column(3)
.From = txtGonderen & "(" & txtgmailadresi & ")"
.Subject = txtKonu
.HTMLBody = Me.Liste1.Column(1)
.Sender = "xx"
.Organization = txtgmailadresi
.ReplyTo = txtgmailadresi
If IsNull(Me.txteklenti) Or Me.txteklenti = "" Then
Else
If InStr(1, Me.txteklenti, ",") > 0 Then
dosya = Split(Me.txteklenti, ",")
For i = LBound(dosya) To UBound(dosya)
.AddAttachment dosya(i)
Next
Else
.AddAttachment Me.txteklenti
End If
End If
Set .Configuration = iConf
.send
End With
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
End Function
