lerdinhos
Posts1Data de inscriçãosegunda 16 de junho de 2014StatusMembroÚltima visitaterça 17 de junho de 2014
-
17 jun 2014 às 08:32
Perfil bloqueado -
17 jun 2014 às 08:39
Ola, eu preciso enviar um e-mail com um anexo através do VB6 eu tenho a rotina certinho que envia o e-mails mas não sei como fazer para enviar anexo alguém poderia me ajudar.
essa rotina envia e-mails normal mas não consigo enviar anexo.
Sub DEMO_EnvoiMailCDO() Dim mMessage As Object Dim mConfig As Object Dim mChps Dim intSmtp As Integer Dim objPsqSystemInfo As New clsPsqSystemInfo Call objPsqSystemInfo.PesquisaTudo
Dim count As Integer Dim EmailPadrao As String Dim a As String
EmailPadrao = Trim(objPsqSystemInfo.EmailPadrao) count = 1 Do
a = Mid(EmailPadrao, count, 1) If a = "@" Then count = count + 1 Exit Do End If
count = count + 1 Loop Until count = Len(EmailPadrao)
If Mid(EmailPadrao, count, Len(EmailPadrao)) = "gmail.com" Then intSmtp = 1 ElseIf Mid(EmailPadrao, count, Len(EmailPadrao)) = "hotmail.com" And Mid(EmailPadrao, count, Len(EmailPadrao)) = "hotmail.com.br" And Mid(EmailPadrao, count, Len(EmailPadrao)) = "live.com" And Mid(EmailPadrao, count, Len(EmailPadrao)) = "live.com.br" Then intSmtp = 2 End If
Set mConfig = CreateObject("CDO.Configuration")
mConfig.Load -1 Set mChps = mConfig.Fields With mChps .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'Adaptar de acordo com seu servidor de e-mail (exemplo para Gmail.)=> Hotmail "smtp.live.com" If intSmtp = 1 Then .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" ElseIf intSmtp = 2 Then .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.live.com" End If 'Em princípiio, 25 funciona com todos os servidores. .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'Você pode tentar sem estas três linhas 'Mas se seu servidor solicita uma autenticação .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1" .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = objPsqSystemInfo.EmailPadrao .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = objPsqSystemInfo.SenhaPadrao 'Se seu servudor solicita uma conexão protegida (SSL) .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true" .Update End With
Set mMessage = CreateObject("CDO.Message") With mMessage Set .Configuration = mConfig .To = objPsqSystemInfo.EnviarPara .From = objPsqSystemInfo.EmailPadrao .Subject = "O objeto do e-mail " .TextBody = "Este e-mail lhe é enviado para testar a macros de lermite" 'Para adicionar um anexo, um arquivo, pasta, imagem, etc. .send End With Set mMessage = Nothing
'Para outra mensagem, não precisa reconfigurar, é preciso, no entanto, recriar uma nova mensagem a cada vez. Set mMessage = CreateObject("CDO.Message") With mMessage Set .Configuration = mConfig .To = objPsqSystemInfo.CopiaPara .From = objPsqSystemInfo.EmailPadrao .Subject = "É para o segundo teste de envio e- " .TextBody = "Este e-mail lhe é enviado para testar a macros de lermite" & Chr(13) _ & "e ver se a segunda mensagem passou bem."
.send End With Set mMessage = Nothing
'Libera os recursos Set mConfig = Nothing Set mChps = Nothing Set objPsqSystemInfo = Nothing End Sub
