22/03/2019, 23:52
(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>"
.