Rank: Administration
Groups: Administrators
Joined: 11/11/2010(UTC) Posts: 1,153
Thanks: 9 times Was thanked: 55 time(s) in 55 post(s)
|
rjiovanni wrote:Code:
'zera atributos
m_oSmtp.Reset 'because m_oSmtp is a member variahle, so we need to clear the the property
m_oSmtp.Asynchronous = 1
m_oSmtp.ServerAddr = ""
m_oSmtp.ServerPort = 25
m_oSmtp.SSL_uninit
m_oSmtp.UserName = ""
m_oSmtp.Password = ""
m_oSmtp.ServerAddr = sServidor_SMTP
m_oSmtp.Protocol = rs!protocolo_envio
If sServidor_SMTP <> "" Then
If rs!autenticacao_requerida Then
m_oSmtp.UserName = rs!usuario
m_oSmtp.Password = rs!senha
End If
If rs!autenticacao_ssl Then
If m_oSmtp.SSL_init() <> 0 Then
MsgBox ("Falha ao carregar a biblioteca SSL!") 'failed to load SSL library
Exit Function
End If
'If SSL port is 465 or other port rather than 25 port, please use
'm_oSmtp.ServerPort = 465
'm_oSmtp.SSL_starttls = 0
End If
End If
m_oSmtp.Charset = rs!encoding 'm_arCharset(24, 1)
Dim name, addr As String
fnParseAddr psEmailDe, name, addr
'Using this email to be replied to another address
'm_oSmtp.ReplyTo = ReplyAddress
m_oSmtp.From = name
m_oSmtp.FromAddr = addr
'add digital signature
m_oSmtp.SignerCert.Unload
If rs!assinatura_digital Then
If Not m_oSmtp.SignerCert.FindSubject(addr, CERT_SYSTEM_STORE_CURRENT_USER, "my") Then
MsgBox m_oSmtp.SignerCert.GetLastError() & ":" & addr
' btnSend.Enabled = True
btnCancel.Enabled = False
Exit Function
End If
If Not m_oSmtp.SignerCert.HasPrivateKey Then
MsgBox "O certificado não possui chave privada, portanto não poderá ser usado na assinatura deste E-mail!" '"Signer certificate has not private key, this certificate can not be used to sign email!"
' btnSend.Enabled = True
btnCancel.Enabled = False
Exit Function
End If
End If
m_oSmtp.AddRecipientEx psEmailPara, 0 ' 0, Normal recipient, 1, cc, 2, bcc
m_oSmtp.AddRecipientEx sEndereco_cc, 0
Dim recipients As String
recipients = psEmailPara & "," & sEndereco_cc
fnTrim recipients, ","
Dim i, Count As Integer
'encrypt email by recipients certificate
m_oSmtp.RecipientsCerts.Clear
If rs!criptografar Then
Dim arAddr
arAddr = SplitEx(recipients, ",") 'split the multiple address to an array
Count = UBound(arAddr)
For i = LBound(arAddr) To Count
addr = arAddr(i)
fnTrim addr, " ,;"
If addr <> "" Then
'find the encrypting certificate for every recipients
Dim oEncryptCert As New EASendMailObjLib.Certificate
If Not oEncryptCert.FindSubject(addr, CERT_SYSTEM_STORE_CURRENT_USER, "AddressBook") Then
If Not oEncryptCert.FindSubject(addr, CERT_SYSTEM_STORE_CURRENT_USER, "my") Then
MsgBox oEncryptCert.GetLastError() & ":" & addr
' btnSend.Enabled = True
btnCancel.Enabled = False
Exit Function
End If
End If
m_oSmtp.RecipientsCerts.Add oEncryptCert
End If
Next
End If
Count = UBound(m_arAttachment)
For i = 0 To Count - 1
If m_oSmtp.AddAttachment(m_arAttachment(i)) <> 0 Then
MsgBox m_oSmtp.GetLastErrDescription() & ":" & m_arAttachment(i)
' btnSend.Enabled = True
btnCancel.Enabled = False
Exit Function
End If
Next
'Salva arquivo de email com base no database (EML e HTML) <<<<<<<<<<<<<<<<<<<<<< SAVE EML and HTML File
If Not eMail_Salvar_EML(pId_Email, sPath_Arq_EML, sPath_Arq_HTML) Then
Atencao "Ocorreram erros na geração do arquivo EML! Verique as permissões da pasta " & pPathEmails
Exit Function
End If
' Load EML file to body text temporally <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< import Mail
m_oSmtp.ImportMail sPath_Arq_EML
' Assign Eml file data to raw content <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< load raw_Content
m_oSmtp.raw_Content = m_oSmtp.BodyText
m_oSmtp.BodyFormat = 1 ' Using HTML FORMAT to send mail
m_oSmtp.Subject = psAssunto '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< NEW SUBJECT
'm_oSmtp.
If InStr(1, recipients, ",", 1) > 1 And sServidor_SMTP = "" Then
'To send email without specified smtp server, we have to send the emails one by one
' to multiple recipients. That is because every recipient has different smtp server.
DirectSend m_oSmtp, recipients
btnCancel.Enabled = False
textStatus.SimpleText = ""
Exit Function
End If
textStatus.SimpleText = "Conectando " & sServidor_SMTP & " ..."
m_bIdle = False
m_bCancel = False
m_bError = False
pgBar.Value = 0
m_oSmtp.SendMail
'wait the asynchronous call finish.
Do While Not m_bIdle
DoEvents
Loop
Hi, if you want to edit the subject, then you should not use raw_Content property. you should use LoadMessage method from: ' Load EML file to body text temporally <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< import Mail m_oSmtp.ImportMail sPath_Arq_EML ' Assign Eml file data to raw content <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< load raw_Content m_oSmtp.raw_Content = m_oSmtp.BodyText m_oSmtp.BodyFormat = 1 ' Using HTML FORMAT to send mail change it to: ' Load EML file to body text temporally <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< import Mail m_oSmtp.LoadMessage sPath_Arq_EML m_oSmtp.BodyFormat = 1
|