Mail Gönderirken Gövdeye Yazı Aralarına Resim Eklemek Ve Satır Ara Boşlukları

1 2
19/03/2019, 18:59

zetyu

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


20/03/2019, 16:02

ozanakkaya

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, 18:49

zetyu

(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.
21/03/2019, 17:30

ozanakkaya

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, 22:34

zetyu

(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.)
22/03/2019, 13:20

ozanakkaya

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
1 2