AccessTr.neT

Bul · 19/03/2019, 18:59

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

[Resim: do.php?imgf=036488d3030c1.gif]

Bul · 20/03/2019, 16:02

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.

Bul · 20/03/2019, 18:49

(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.

Bul · 21/03/2019, 17:30

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.

Bul · 21/03/2019, 22:34

(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.)

Bul · 22/03/2019, 13:20

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

AccessTr.neT

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

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

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Giriş yap

Hesap oluştur

Konu Linkleri