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

1 2
22/03/2019, 23:52

zetyu

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

Teşekkürler Ozan hocam
elinize emeğinize sağlık.
çok teşekkür ederim ilginize.
arzu ettiğimden  fazlasını yaptınız hocam

Konuyu cevaplanmışlar bölümüne taşıyabilirsiniz.









Not:Resme link için aşağıdaki kod kullanılabilir.
Dim linkLogoURL As String


 txtLogoURL = "http://www.xxxxxx.png"
    linkLogoURL = "https://www.xxxxx.com"
       strBody = strBody & "<a img border=""0"" href=" & linkLogoURL & " target=""_blank""> <img src=" & txtLogoURL & "> </a>"












.
1 2