Dim objCDOMail As Object
Const cdoAnonymous = 0
Const cdoBasic = 1
Const cdoNTLM = 2
Set objMessage = CreateObject("CDO.Message")
objMessage.BodyPart.Charset = "UTF-8"
objMessage.Subject = Me.txtKonu
objMessage.From = Me.txtGonderen & "<" & Me.txtmailadresi & ">"
objMessage.To = Me.Metin7
GMetin = Replace(Me.txtmetin, vbCrLf, "<br />")
objMessage.HTMLBody = GMetin & "<br /> <strong><font color= 0 > " & Me.konn & "<br /><strong><font color= 0 > " & Me.konu2 & "<br /> <strong><font color= 0 > " & Me.konu3 & "<br /> <strong><font color= 0 > " & Me.dilek & "<br />----<br />" & "<br /> <strong><font color= 6881490 > " & Me.Metin57 & "<br /> <strong><font color= 6881490 > " & Me.cep & " <br /><strong><font color= 0 > " & "TEL : " & Me.Tel & "<br /> <strong><font color= 0 > " & "FAX : " & Me.fax & "<br /> <strong><font color= 16711680 > " & Me.Mail & "<br /> <strong><font color= 6881490 > " & Me.web & "<br /><strong><font color= 16711680 > " & Me.web1
' & "<img src=""cid:resimtest.png"" width=""235"" height=""70"" border=""0"">"
objMessage.AddAttachment "C:\resimtest.png"
On Error GoTo Hata
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)
objMessage.AddAttachment Dosya(i)
Next
Else
objMessage.AddAttachment Me.txtEklenti
End If
End If
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Me.txtsunucuadresi
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = Me.txtmailadresi
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Me.txtmailsifre
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
objMessage.Configuration.Fields.Update
objMessage.Send
MsgBox "Mail gönderimi başarılı.", vbInformation, "İşlem tamam"
Exit Function
Hata: MsgBox "Mail gönderimi başarısız.", vbCritical, "Hata oluştu."kod içerisindeki "C:\resimtest.png" dizinini kendi resmine göre değiştir.
