Boa tarde amigos
Dá erro na parte a vermelho .send
Sub EnviarEmail()
'On Error GoTo erromail
Dim Mens As CDO.Message
Dim Config As CDO.Configuration
Set Config = New CDO.Configuration
With Config
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Me.SMTP 'aqui foi configurado para uma conta de email do sapo, que é grátis
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Me.Porta ' porta usada pelo sapo
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = Me.Email 'se o email a ser usado para envio for fulano@bol.com.br, coloque fulano aqui
.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Me.Pass 'coloque a senha do seu email
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Fields.Update
End With
Set Mens = New CDO.Message
With Mens
Set .Configuration = Config
.From = Forms!Menu!Nome 'Nome de quem envia
If Not IsNull(Me.txtDeMail) Then
.Sender = Me.Email 'email de quem envia.
End If
If Not IsNull(Me.txtCOculta) Then
.BCC = Me.txtCOculta
End If
.Subject = Me.txtAssunto 'caixa texto assunto
.TextBody = Me.txtMensagem 'Caixa texto com o texto
.To = Me.txtPara 'caixa texto para quem vai o email"
If Not IsNull(Me.txtAnexo) Then
.AddAttachment (Me.txtAnexo)
End If
If Not IsNull(Me.txtAnexo1) Then
.AddAttachment (Me.txtAnexo1)
End If
If Not IsNull(Me.txtAnexo2) Then
.AddAttachment (Me.txtAnexo2)
End If
DoCmd.openForm "frmProgresso"
.Send ' envia
End With
MsgBox "@Mail Enviado com Sucesso", vbExclamation, "Gestão de @Mails"
DoCmd.Close acForm, "frmProgresso"
DoCmd.Close acForm, "email"
Set Mens = Nothing
Set Config = Nothing
Exit Sub
erromail:
Set Mens = Nothing
Set Config = Nothing
Exit Sub
End Sub
Obrigado
Com win 8 enviava sem problemas.
Dá erro na parte a vermelho .send
Sub EnviarEmail()
'On Error GoTo erromail
Dim Mens As CDO.Message
Dim Config As CDO.Configuration
Set Config = New CDO.Configuration
With Config
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Me.SMTP 'aqui foi configurado para uma conta de email do sapo, que é grátis
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Me.Porta ' porta usada pelo sapo
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = Me.Email 'se o email a ser usado para envio for fulano@bol.com.br, coloque fulano aqui
.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Me.Pass 'coloque a senha do seu email
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Fields.Update
End With
Set Mens = New CDO.Message
With Mens
Set .Configuration = Config
.From = Forms!Menu!Nome 'Nome de quem envia
If Not IsNull(Me.txtDeMail) Then
.Sender = Me.Email 'email de quem envia.
End If
If Not IsNull(Me.txtCOculta) Then
.BCC = Me.txtCOculta
End If
.Subject = Me.txtAssunto 'caixa texto assunto
.TextBody = Me.txtMensagem 'Caixa texto com o texto
.To = Me.txtPara 'caixa texto para quem vai o email"
If Not IsNull(Me.txtAnexo) Then
.AddAttachment (Me.txtAnexo)
End If
If Not IsNull(Me.txtAnexo1) Then
.AddAttachment (Me.txtAnexo1)
End If
If Not IsNull(Me.txtAnexo2) Then
.AddAttachment (Me.txtAnexo2)
End If
DoCmd.openForm "frmProgresso"
.Send ' envia
End With
MsgBox "@Mail Enviado com Sucesso", vbExclamation, "Gestão de @Mails"
DoCmd.Close acForm, "frmProgresso"
DoCmd.Close acForm, "email"
Set Mens = Nothing
Set Config = Nothing
Exit Sub
erromail:
Set Mens = Nothing
Set Config = Nothing
Exit Sub
End Sub
Obrigado
Com win 8 enviava sem problemas.