mail de metin alanının renkli olması

10/01/2013, 00:05

svs007

Merhaba,

Mail gönderirken metin alanının renlendirmek istiyorum. aşağıdaki kodda nasıl bir değişiklik yapılmalıdır.

Teşekkürler , iyi akşamlar

///

Function SendMail()
Dim objCDOMail As Object

Const cdoAnonymous = 0
Const cdoBasic = 1
Const cdoNTLM = 2
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = Me.txtKonu
objMessage.From = Me.txtGonderen & "<" & Me.txtmailadresi & ">"
objMessage.To = Me.Metin7

objMessage.HTMLBody = txtmetin

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") = 587

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False

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

Private Sub Ayrıntı_Click()

End Sub

Private Sub Ekle_Click()
If IsNull(Me![txtEklenti]) Then
Dosya = GetOpenFile_CLT("", "Gönderilecek Dosya Seçin.")
Me![txtEklenti] = Dosya
Me.Metin22 = Dir(Dosya)
Dosya = ""
Else
Dosya = GetOpenFile_CLT("", "Gönderilecek Dosya Seçin.")
Me![txtEklenti] = Me![txtEklenti] & "," & Dosya
Me.Metin22 = Me.Metin22 & "," & Dir(Dosya)
End If
End Sub

Private Sub Form_Open(Cancel As Integer)
Me.ProgressBar1.Visible = False
End Sub

Private Sub Kapat_Click()
DoCmd.Close

End Sub
Private Sub Komut13_Click()

If IsNull(Metin7) Or IsNull(txtGonderen) Or IsNull(txtKonu) Or IsNull(txtsunucuadresi) Or IsNull(txtmailadresi) Or IsNull(txtmailsifre) Then

MsgBox "Tüm alanları eksiksiz olarak doldurmanız gerekmektedir kontrol edip tekrar deneyiniz!! ", vbCritical + vbOKOnly, "Eksik Bırakılan Alan !!!"
Exit Sub
Else
Me.ProgressBar1.Visible = True

Dim I As Integer

For I = 1 To 10000

ProgressBar1.Value = (I / 10000) * 100



Next I
SendMail
End If
Me.ProgressBar1.Visible = False
End Sub

Private Sub Sil_Click()
Me.txtEklenti = Null
Me.Metin22 = Null
End Sub

///
10/01/2013, 20:27

Yandemir

objMessage.HTMLBody = txtmetin

satırında Html kodları yollayabilirsiniz. dizaynınız karşı tarafa aynen gider.