(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 />")

Kodu Seç

Kodu Kopyala

ş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 Seç

Kodu Kopyala

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

Kodu Seç

Kodu Kopyala

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>"












.