E-mail desde formulario
Quiero mandar desde un botón de un formulario, un e-mail con un informe adjunto.
El correo remitente y destinatario es Lotus Notes del trabajo.
Con el código que pongo más abajo (encontrado en internet) no he conseguido hacerlo ya que me sale el siguiente mensaje:
"el servidor rechazo una o mas direcciones de destinatarios. Respuesta del servidor: xxx y.y.y <xx.Red-xx-xxx-xxx.dynamicIP.rima-tde.net[xx.xxx.xxx.xx]>: Client
Host rejected: Your message was rejected due to a spam filtering.
Please see http://www.sophos.com/security/ip-lookup?ip=xx.xxx.xxx.xx"
Probé a cambiar el correo remitente por uno de terra y sí me envió el mensaje (aunque en la bandeja de enviados de terra no constaba).
¿Me podrías orientar para solucionar el mensaje de error?
Ya puestos... ¿Podría aparecer en la bandeja de enviados?
Si te parece mejor otra manera de hacerlo, perfecto.
Gracias de antemano y discúlpame porque mis conocimientos son bastante limitados.
El código al que me refería es el siguiente:
Private Sub Comando29_Click()
On Error GoTo sol_err
'Definimos dos constantes, donde introduciremos la cuenta de correo, el password y el smtp
Const miMail As String = "[email protected]"
Const miPass As String = "xxxxxxx"
Const miSmtp As String = "smtp.terra.es"
'Definimos las variables
Dim elAsunto As String, elMsg As String
Dim mailA As String, mailCC As String, mailCCO As String
'Inicializamos las variables
elAsunto = Nz(Me.TxtAsunto.Value, "")
elMsg = Nz(Me.txtMsg.Value, "")
mailA = Nz(Me.MailCont.Value, "")
mailCC = Nz(Me.cboCC.Value, "")
mailCCO = Nz(Me.cboCCO.Value, "")
'Si no hay destinatario avisamos y salimos del proceso
If mailA = "" Then
MsgBox "¡Debe existir un destinatario!", vbCritical, "SIN DESTINATARIO"
Exit Sub
End If
'Exportamos el informe a la carpeta donde está la BD en formato snapshot
Dim ruta As String, miInforme As String
ruta = Application.CurrentProject.Path & "\"
miInforme = ruta & "Informe.snp"
DoCmd.OutputTo acOutputReport, "RDatos", acFormatTXT, miInforme, False
'Configuramos el bloque CDO
Dim cdoConfig
Dim msgOne
Set cdoConfig = CreateObject("CDO.Configuration")
With cdoConfig.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = miSmtp
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = miMail
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = miPass
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Update
End With
'Configuramos el mensaje
Set msgOne = CreateObject("CDO.Message")
Set msgOne.Configuration = cdoConfig
msgOne.To = mailA
msgOne.CC = mailCC
msgOne.BCC = mailCCO
msgOne.From = miMail
msgOne.Subject = elAsunto
msgOne.TextBody = elMsg
'Configuramos el adjunto
Dim miAdjunto As String
miAdjunto = "file://" & miInforme
If Not IsMissing(miInforme) Then
msgOne.AddAttachment (miAdjunto)
End If
msgOne.Send
'Avisamos de que el envío ha ido bien
MsgBox "Mensaje enviado con éxito", vbInformation, "CORRECTO"
'Eliminamos el informe de nuestra carpeta
Kill miInforme
Salida:
Exit Sub
sol_err:
MsgBox Err.Number & ": " & Err.Description
Resume Salida
End Sub