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///
Yollar biter Access bitmez. 