ENVIO DE EMAIL COM TEXTO EM HTML
Bom dia!
Preciso desenvolver uma ferramenta, em VB6, que envie email com texto em HTML.
Me parece que o melhor caminho seria usar o CDONTS, mas para as versões de Office 2010 e 2013 ele é incompatÃvel.
Pelo material que eu li acredito que o melhor seria via MAPI, mas qual DLL usar sendo compatÃvel com Office 2010 e 2013???
Preciso desenvolver uma ferramenta, em VB6, que envie email com texto em HTML.
Me parece que o melhor caminho seria usar o CDONTS, mas para as versões de Office 2010 e 2013 ele é incompatÃvel.
Pelo material que eu li acredito que o melhor seria via MAPI, mas qual DLL usar sendo compatÃvel com Office 2010 e 2013???
[txt-color=#007100]ENVIA COMO HTML E COM VARIOS ANEXOS[/txt-color]
[txt-color=#0000f0]Private Sub cmdSend_Click()
On Error Resume Next
Dim RetVal As String
Dim objControl As Control
[ô]Validate first
For Each objControl In Me.Controls
If TypeOf objControl Is TextBox Then
If Trim$(objControl.Text) = vbNullString And LCase$(objControl.Name) <> [Ô]txtattach[Ô] Then
Label2.Caption = [Ô]Todos os campos são requeridos![Ô]
Exit Sub
End If
End If
Next
[ô]Send
[ô] Frame1.Enabled = False
Frame2.Enabled = False
cmdSend.Enabled = False
Label2.Caption = [Ô]Enviando...[Ô]
RetVal = SendMail(Trim$(txtTo.Text), _
Trim$(txtSubject.Text), _
Trim$(txtFromName.Text) & [Ô]<[Ô] & Trim$(txtFromEmail.Text) & [Ô]>[Ô], _
Trim$(txtMsg.Text), _
Trim$(txtServer.Text), _
CInt(Trim$(txtPort.Text)), _
Trim$(txtUsername.Text), _
Trim$(txtPassword.Text), _
lstAnexos, _
CBool(chkSSL.Value))
Frame1.Enabled = True
Frame2.Enabled = True
cmdSend.Enabled = True
Label2.Caption = IIf(RetVal = [Ô]ok[Ô], [Ô]Menssagem Enviada![Ô], RetVal)
End Sub
[/txt-color]
[txt-color=#e80000]Public Function SendMail(sTo As String, sSubject As String, sFrom As String, _
sBody As String, sSmtpServer As String, iSmtpPort As Integer, _
sSmtpUser As String, sSmtpPword As String, _
sFilePath As String, bSmtpSSL As Boolean) As String
On Error GoTo SendMail_Error:
Dim lobj_cdomsg As cdo.Message
Set lobj_cdomsg = New cdo.Message
lobj_cdomsg.Configuration.Fields(cdoSMTPServer) = sSmtpServer
lobj_cdomsg.Configuration.Fields(cdoSMTPServerPort) = iSmtpPort
lobj_cdomsg.Configuration.Fields(cdoSMTPUseSSL) = bSmtpSSL
lobj_cdomsg.Configuration.Fields(cdoSMTPAuthenticate) = cdoBasic
lobj_cdomsg.Configuration.Fields(cdoSendUserName) = sSmtpUser
lobj_cdomsg.Configuration.Fields(cdoSendPassword) = sSmtpPword
lobj_cdomsg.Configuration.Fields(cdoSMTPConnectionTimeout) = 30
lobj_cdomsg.Configuration.Fields(cdoSendUsingMethod) = cdoSendUsingPort
lobj_cdomsg.Configuration.Fields.Update
lobj_cdomsg.To = sTo
lobj_cdomsg.From = sFrom
lobj_cdomsg.Subject = sSubject
If Option1.Value = True Then
lobj_cdomsg.HTMLBody = sBody
Else
lobj_cdomsg.TextBody = sBody
End If
If lstAnexos.ListCount = 0 Then
Else
lstAnexos.ListIndex = lstAnexos.TopIndex
Dim l As Long
For l = 0 To lstAnexos.ListCount - 1
lobj_cdomsg.AddAttachment lstAnexos.List(l)
Next l
End If
lobj_cdomsg.sEnd
Set lobj_cdomsg = Nothing
SendMail = [Ô]ok[Ô]
Exit Function
SendMail_Error:
SendMail = Err.Description
[ô]
End Function[/txt-color]
[txt-color=#0000f0]Private Sub cmdSend_Click()
On Error Resume Next
Dim RetVal As String
Dim objControl As Control
[ô]Validate first
For Each objControl In Me.Controls
If TypeOf objControl Is TextBox Then
If Trim$(objControl.Text) = vbNullString And LCase$(objControl.Name) <> [Ô]txtattach[Ô] Then
Label2.Caption = [Ô]Todos os campos são requeridos![Ô]
Exit Sub
End If
End If
Next
[ô]Send
[ô] Frame1.Enabled = False
Frame2.Enabled = False
cmdSend.Enabled = False
Label2.Caption = [Ô]Enviando...[Ô]
RetVal = SendMail(Trim$(txtTo.Text), _
Trim$(txtSubject.Text), _
Trim$(txtFromName.Text) & [Ô]<[Ô] & Trim$(txtFromEmail.Text) & [Ô]>[Ô], _
Trim$(txtMsg.Text), _
Trim$(txtServer.Text), _
CInt(Trim$(txtPort.Text)), _
Trim$(txtUsername.Text), _
Trim$(txtPassword.Text), _
lstAnexos, _
CBool(chkSSL.Value))
Frame1.Enabled = True
Frame2.Enabled = True
cmdSend.Enabled = True
Label2.Caption = IIf(RetVal = [Ô]ok[Ô], [Ô]Menssagem Enviada![Ô], RetVal)
End Sub
[/txt-color]
[txt-color=#e80000]Public Function SendMail(sTo As String, sSubject As String, sFrom As String, _
sBody As String, sSmtpServer As String, iSmtpPort As Integer, _
sSmtpUser As String, sSmtpPword As String, _
sFilePath As String, bSmtpSSL As Boolean) As String
On Error GoTo SendMail_Error:
Dim lobj_cdomsg As cdo.Message
Set lobj_cdomsg = New cdo.Message
lobj_cdomsg.Configuration.Fields(cdoSMTPServer) = sSmtpServer
lobj_cdomsg.Configuration.Fields(cdoSMTPServerPort) = iSmtpPort
lobj_cdomsg.Configuration.Fields(cdoSMTPUseSSL) = bSmtpSSL
lobj_cdomsg.Configuration.Fields(cdoSMTPAuthenticate) = cdoBasic
lobj_cdomsg.Configuration.Fields(cdoSendUserName) = sSmtpUser
lobj_cdomsg.Configuration.Fields(cdoSendPassword) = sSmtpPword
lobj_cdomsg.Configuration.Fields(cdoSMTPConnectionTimeout) = 30
lobj_cdomsg.Configuration.Fields(cdoSendUsingMethod) = cdoSendUsingPort
lobj_cdomsg.Configuration.Fields.Update
lobj_cdomsg.To = sTo
lobj_cdomsg.From = sFrom
lobj_cdomsg.Subject = sSubject
If Option1.Value = True Then
lobj_cdomsg.HTMLBody = sBody
Else
lobj_cdomsg.TextBody = sBody
End If
If lstAnexos.ListCount = 0 Then
Else
lstAnexos.ListIndex = lstAnexos.TopIndex
Dim l As Long
For l = 0 To lstAnexos.ListCount - 1
lobj_cdomsg.AddAttachment lstAnexos.List(l)
Next l
End If
lobj_cdomsg.sEnd
Set lobj_cdomsg = Nothing
SendMail = [Ô]ok[Ô]
Exit Function
SendMail_Error:
SendMail = Err.Description
[ô]
End Function[/txt-color]
Faça seu login para responder