mail gönderme koduna liste kutusundan veri alması için döngü eklemeniz gerekli. Kodu aşağıdaki ile değiştirerek deneyiniz.
Private Sub Komut13_Click()
If (IsNull(txtgmailadresi)) Or (IsNull(txtgmailsifre)) Or (IsNull(txtKonu)) 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
For GSayi = 0 To Me.Liste1.ListCount - 1 'eklenen kod
With iMsg
.To = Me.Liste1.Column(3, Gsayi)
.From = txtGonderen & "(" & txtgmailadresi & ")"
.Subject = txtKonu
.HTMLBody = Me.Liste1.Column(1, GSayi) 'düzeltilen kod
.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
Next 'eklenen kod
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
End Function