Skip to main content

AccessTr.neT M.


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ı

Çözüldü #1
Son Düzenleme: 21/03/2019, 22:48, Düzenleyen: 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

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

.rar OzanAKKAYA_mail resim_satir_sld.rar (Dosya Boyutu: 275,37 KB | İndirme Sayısı: 1)
zetyu, 11-03-2009 tarihinden beri AccessTr.neT üyesidir.
Cevapla
#2
Merhaba, kodu aşağıdaki ile değiştir.

Visual Basic Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
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.

"Boş Örnek Eklerim, Yapıp Verirler" demeyin, örneğinizi hazırlayın.
Komplike kod talebiniz var ise İletişim bağlantısından bize ulaşın. 
Cebelleşmezsen Öğrenemezsin. 
Cevapla
...........
#3
Son Düzenleme: 20/03/2019, 18:50, Düzenleyen: zetyu.
(20/03/2019 16:02)ozanakkaya Adlı Kullanıcıdan Alıntı: Merhaba, kodu aşağıdaki ile değiştir.

Visual Basic Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
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.

zetyu, 11-03-2009 tarihinden beri AccessTr.neT üyesidir.
Cevapla
#4
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.

.rar mail resim_satir_sld.rar (Dosya Boyutu: 231,77 KB | İndirme Sayısı: 6)
"Boş Örnek Eklerim, Yapıp Verirler" demeyin, örneğinizi hazırlayın.
Komplike kod talebiniz var ise İletişim bağlantısından bize ulaşın. 
Cebelleşmezsen Öğrenemezsin. 
Cevapla
...........
#5
Son Düzenleme: 22/03/2019, 00:51, Düzenleyen: zetyu.
(21/03/2019 17:30)ozanakkaya Adlı Kullanıcıdan Alıntı: 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.)

zetyu, 11-03-2009 tarihinden beri AccessTr.neT üyesidir.
Cevapla
#6
txtmetin isimli metin kutusuna girilen veride boşluk sorununu çözmek için


Visual Basic Code
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


Visual Basic Code
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.


Visual Basic Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
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

"Boş Örnek Eklerim, Yapıp Verirler" demeyin, örneğinizi hazırlayın.
Komplike kod talebiniz var ise İletişim bağlantısından bize ulaşın. 
Cebelleşmezsen Öğrenemezsin. 
Cevapla
...........

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

Yorum yapmak için üye olmanız gerekiyor

ya da