Hocalarımızn hazırlamış olduğu uygulama sayesinde mail gönderebiliyorum.bir müddettirde kullanıyorum ellerine sağlık.
Ancak mail gönderirken görsellik kalitesini artırmak istiyorum.
1---Mailde gövdeye resim eklemek
mail gönderdiğimde gövdeye yazı aralarına resim eklemek istiyorum.
siteyi bir iki gündür bu konu ile ilgili incelediğimde mail de yazı arasına resim koyabiliyoruz galiba .Örnekler var ama
Access 2010 da ben 2003 kullanıyorum.
objMessage.HTMLBody =… .... alanında
Html ile yapabilirmiyim diye denedim ama olmadı.
2.Satır Aralarında ve cümle aralarında boşluk bırakamıyorum.
Metin kutusunda yazı yazdığımda satır araları ve boşluklar görünmüyor.
vbNewLine kodunu benim örnekte nereye koyabilirim bilmediğim için örnekte uygulayamadım
Merhaba, kodu aşağıdaki ile değiştir.
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.
(20/03/2019, 16:02)ozanakkaya yazdı: Merhaba, kodu aşağıdaki ile değiştir.
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.
Ozan Hocam teşekkür ederim elinize sağlık.
Ancak bu kod ile mail de resmi ek olarak atabiliyoruz.Şu an bu mail uygulamasında dosya ve resim ek olarak gönderilebiliyor.
Benim arzu ettiğim şey ise mailde yazı arasında resim gönderebilirmiyim.
ve ayrıca satır aralarındaki boşluk yerine yanyana yazma devam ediyor.
Metin kutusuna veriyi nasıl giriyorsunuz bilmiyorum, ancak enter ile alt satıra geçilerek girilen verilerdeki hata bende yok.
Resim eklenir hale getirdim. Önceki tasarım değiştirildi. Resim gönderme olayı tamam ise
Html tasarım olayı kolay.
(21/03/2019, 17:30)ozanakkaya yazdı: Metin kutusuna veriyi nasıl giriyorsunuz bilmiyorum, ancak enter ile alt satıra geçilerek girilen verilerdeki hata bende yok.
Resim eklenir hale getirdim. Önceki tasarım değiştirildi. Resim gönderme olayı tamam ise Html tasarım olayı kolay.
Ozan Hocam ellerinize sağlık
Resim olayı çok güzel oldu .elinize sağlık
diğer sorunum kaldı.satır da enter yapsamda satır araları mailde bir çıkıyor.
(ilk örneği düzenlenmiş haliyle tekrar yükledim satır ile ilgili durumu görebilirsiniz.)
txtmetin isimli metin kutusuna girilen veride boşluk sorununu çözmek için
GMetin = Replace(Me.txtmetin, vbCrLf, "<br />")
şeklinde kod ekli. konn, konu2 ve konu3 isimli metin kutularındaki sorunu çözmek için üstteki kodu uyarlayarak koda eklemeniz gerekiyordu.
Kod içerisinde resim linkini
txtLogoURL = "https://accesstr.net/uploads/avatars/avatar_61698.png?dateline=1393332365"
kodu mevcut. Sizin bu resmi metin88'e yazılan linkteki resmi kullanmanız için kodu
txtLogoURL = metin88
şeklinde değiştirmeniz gerekli.
Function SendMail()
Dim objCDOMail As Object
Dim strBody As String
Dim txtLogoURL As String
Dim objMessage 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
GMetin1 = Replace(Me.txtmetin, vbCrLf, "<br />")
GMetin2 = Replace(Me.konn, vbCrLf, "<br />")
GMetin3 = Replace(Me.konu2, vbCrLf, "<br />")
GMetin4 = Replace(Me.konu3, vbCrLf, "<br />")
txtLogoURL = "https://accesstr.net/uploads/avatars/avatar_61698.png?dateline=1393332365"
strBody = strBody & "<p><strong><font size=4 color= 000080 > " & "" & GMetin1 & "</p>"
strBody = strBody & "<p><strong><font size=3 color= 000080 > " & "" & GMetin2 & "</p>"
strBody = strBody & "<img border=""0"" src=" & txtLogoURL & " alt=""Resim"" />"
strBody = strBody & "<p><strong><font size=3 color= 000080 > " & "" & GMetin3 & "</p>"
strBody = strBody & "<p><strong><font size=3 color= 000080 > " & "" & GMetin4 & "</p>"
strBody = strBody & "<p><strong><font size=3 color= 000080 > " & "" & GMetin4 & "</p>"
strBody = strBody & "<p><br></br><strong><font size=4 color= 000080 > " & "" & Me.dilek & "</p>"
strBody = strBody & "<p><strong><font size=2 color= 000080 > " & "" & Me.adi & "</p>"
strBody = strBody & "<p><strong><font size=1 color= 0 > " & "" & Me.Unvani & "</p>"
strBody = strBody & "<p><strong><font size=1 color= 0 > " & "" & Me.gorev & "</p>"
strBody = strBody & "<p><strong><font size=1 color= 0 > " & "" & Me.[adres] & "</p>"
strBody = strBody & "<p><strong><font size=1 color= 0 > " & "CEP : " & Me.cep & "</p>"
strBody = strBody & "<p><strong><font size=1 color= 0 > " & "TEL : " & Me.Tel & " & FAX : " & Me.fax & "</p>"
strBody = strBody & "<p><strong><font size=1 color= 0 > " & "FAX : " & Me.fax & "</p>"
strBody = strBody & "<p><strong><font size=1 color= 0 > " & "E-mail : " & Me.Mail & "</p>"
strBody = strBody & "<p><strong><font size=1 color= 0 > " & "WEB : " & Me.web & "</p>"
strBody = strBody & "<p><strong><font size=1 color= 0 > " & "WEB : " & Me.web1 & "</p>"
strBody = strBody & "<img border=""0"" src=" & txtLogoURL & " alt=""Safe Car Auto Transport"" />"
strBody = strBody & "<br><br></body></html>"
objMessage.HTMLBody = strBody
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."
End Function