[Resolvido]Email via sapo

Alguém tem um exemplo de envio de email com anexos via @sapo.pt

Ou pode informar se os códigos vba são iguais aos do outlook ou do gmail

Olá queridos,

Segue link para baixar sistema.

https://drive.google.com/open?id=0B-3RYkSYSCiPdmx4b01mQUVDaW8

Gera PDF e enviar e-mail com o anexo.

Abraço a todos.

Jomar Mattos

Boa tarde, toyebom
Movi o tema para esta sala.
A sala de repositórios não deve ser utilizada para tirar dúvidas

Obrigado Alexandre não tinha percebido quando coloquei a duvida.

jomarmattos
O seu exemplo dá para o email do sapo.pt, é que eu nunca tbalhei com email da sapo nem tenho só utilizo o outlook e o gmail mas um amigo pediu-me uma bd para email da sapo só que não sei se os códigos de envio são iguais aos do gmail, se forem consigo resolver se não forem tou lixado

Olá, aparentemente sim:
Veja configurações que retirei da ajuda do sapo:

Configuração POP/ IMAP/ SMTP
Para usar a sua conta SAPO Mail num programa de correio eletrónico, como o Outlook, ou num dispositivo como um tablet ou smartphone deverá usar as configurações abaixo indicadas.

Para a receção de mensagens poderá usar o protocolo POP ou o protocolo IMAP. Para o envio de mensagens deverá usar o protocolo SMTP.

POP (para a receção de correio)

Servidor de correio recebido (POP3):

- pop.sapo.pt para emails @sapo.pt
- pop.sapo.cv para emails @sapo.cv
- pop.sapo.ao para emails @sapo.ao
- pop.sapo.mz para emails @sapo.mz
- pop.sapo.tl para emails @sapo.tl
- pop.meo.pt para emails @meo.pt
Porta: 110
Porta com SSL (só aplicável a pop.sapo.pt): 995

________________________________________________________________________________________________________________________

IMAP (alternativa para receção de correio)

Servidor de correio recebido (IMAP):

- imap.sapo.pt para emails @sapo.pt
- imap.sapo.cv para emails @sapo.cv
- imap.sapo.ao para emails @sapo.ao
- imap.sapo.mz para emails @sapo.mz
- imap.sapo.tl para emails @sapo.tl
- imap.meo.pt para emails @meo.pt
Porta: 143
Porta com SSL (só aplicável a imap.sapo.pt): 993

________________________________________________________________________________________________________________________

SMTP (para envio de correio)

Servidor de correio enviado (SMTP):

- smtp.sapo.pt para emails @sapo.pt
- smtp.sapo.cv para emails @sapo.cv
- smtp.sapo.ao para emails @sapo.ao
- smtp.sapo.mz para emails @sapo.mz
- smtp.sapo.tl para emails @sapo.tl
- smtp.meo.pt para emails @meo.pt
Porta: 25
Porta com SSL (só aplicável a smtp.sapo.pt): 465 ou 587

Requer autenticação: Selecione esta opção nas definições do servidor de envio (SMTP) e use como credenciais o seu endereço de email SAPO e a respetiva password

Abraço

Então neste código abaixo basta mudar:

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.sapo.pt" 'pode ser usado outro

------------------------------------------------------------------------------------

Sub EnviarEmailCDOSolicitante()
Dim oMensagem As Object
Dim oConfiguração As Object
Dim sCorpo As String
Dim vFields As Variant
Dim sDestinatário As String
Dim sCc As String
Dim sCco As String
Dim sMsgTempo As String
Dim strLocal As String

sDestinatário = EMail
'sCc = ""
'sCco = ""
If Not IsNull([arquivo]) Then
strLocal = arquivo
Else
End If

'If MsgBox("Enviar e-mail para o destinatário " & Destinatário & vbNewLine & _
'"através do e-mail " & sDestinatário, vbYesNo + vbQuestion, " InfoBasic Smart System") = vbYes Then

'If IsNull(sDestinatário) Then
'MsgBox "Não há endereço de e-mail" & Chr(10) & _
'"cadastrado para o destinatário " & Destinatário & "!", vbOKOnly + vbInformation
'Exit Sub
'End If

If IsNull(EMail) Then
MsgBox "O e-mail não pode ser enviado!" & Chr(10) & _
"Verifique a existência do endereço.", vbOKOnly + vbCritical
Exit Sub
End If

If IsNull(Assunto) Then
MsgBox "O e-mail não pode ser enviado!" & Chr(10) & _
"Informe o Assunto deste encaminhamento.", vbOKOnly + vbCritical
Me.Assunto.SetFocus
DoCmd.CancelEvent
Exit Sub
End If

If Me.Texto = "" Then
MsgBox "O e-mail não pode ser enviado!" & Chr(10) & _
"O campo Mensagem encontra-se em branco.", vbOKOnly + vbCritical
Me.Texto.SetFocus
DoCmd.CancelEvent
Exit Sub

Else

DoCmd.OpenForm "frmProgresso"
Forms!frmProgresso!lblInfo.Caption = "Enviando dados..." & vbCrLf & "Esse processo pode levar vários minutos dependendo o tamanho dos arquivos enviados e da velocidade da Internet." & vbCrLf & vbCrLf & "Por favor, aguarde..."


Set oMensagem = CreateObject("CDO.Message")
Set oConfiguração = CreateObject("CDO.Configuration")

oConfiguração.Load -1 'Padrões CDO
Set vFields = oConfiguração.Fields
With vFields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" 'pode ser usado outro smtpserver
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 ' existem outros smtpserverport. verifique na internet
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "email@gmail.com" 'petrus.empresarial@gmail.com
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "PALAVRAPASS"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

.Update
End With

If Format(Now, "hh:mm:ss") >= "00:00:01" And Format(Now, "hh:mm:ss") < "12:00:00" Then
sMsgTempo = "bom dia"
ElseIf Format(Now, "hh:mm:ss") >= "12:01:00" And Format(Now, "hh:mm:ss") < "18:00:00" Then
sMsgTempo = "boa tarde"
ElseIf Format(Now, "hh:mm:ss") >= "18:01:00" And Now = Format(Now, "hh:mm:ss") < "23:59:59" Then
sMsgTempo = "boa noite"
End If


sCorpo = "Prezado(a) Senhor(a), " & [sMsgTempo] & vbNewLine & _
vbNewLine & _
Texto & vbNewLine & _
vbNewLine & _
vbNewLine & _
DLookup("[RSocial]", "tblEmpresa") & vbNewLine & _
"Endereço: " & [txtEnder] & vbNewLine & _
"Fale conosco: Tel/Fax " & [txtComunicação] & vbNewLine

With oMensagem
Set .Configuration = oConfiguração
.To = Me.EMail 'mude aqui para alterar o destinatário
If IsNull([Cc]) Then
.Cc = ""
Else
.Cc = Me.Cc 'com cópia
End If
If IsNull([Cco]) Then
.BCC = ""
Else
.BCC = Me.Cco 'com cópia oculta
End If
.From = """email@gmail.com"" " 'mude para o seu e-mail
.Subject = "Assunto " & Assunto ' mude para o assunto que desejar
.TextBody = sCorpo
If Not IsNull([arquivo]) Then
.AddAttachment strLocal
Else: End If
.Send
End With
DoCmd.Close acForm, "frmProgresso"
MsgBox "E-mail enviado com sucesso. ", vbInformation, " InfoBasic Smart System"
End If
Exit Sub

End Sub

Olá Nuno, as configurações é nesta parte:

Código:

oConfiguração.Load -1 'Padrões CDO
Set vFields = oConfiguração.Fields
With vFields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" 'pode ser usado outro smtpserver
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 ' existem outros smtpserverport. verifique na internet
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "email@gmail.com" 'petrus.empresarial@gmail.com
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "PALAVRAPASS"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60


Abraço

ou seja, fica assim:

.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.sapo.pt" 'pode ser usado outro smtpserver
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 ' existem outros smtpserverport. verifique na internet
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "meuemail@sapo.pt" 'petrus.empresarial@gmail.com
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "PALAVRAPASS"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

O resto mantenho tudo como está.

Olá,
Sim aparentemente e segundo informação do Sapo é o necessário.
Já testou?
Abraço

Testei e funciona 100% obrigado.

Olá Nuno,
Obrigado pelo rtetorno.
Os utilizadores do fórum agradecem.
Abraço