Access - Enviar e-mail a traves de acces

Buenas tardes
Tengo el siguiente codigo que encontre y modifique, para enviar un e-mail adjuntando un fichero desde una aplicacion en access.

Function Envia()
Dim Mensaje As Object
Dim strFichero As String
Dim strDestinatario As String
strDestinatario = Forms!FORM1!Destinatario.Value
strFichero = Forms!FORM1!Fichero.Value
Set Mensaje = CreateObject("CDO.Message")
Mensaje.To = strDestinatario
Mensaje.subject = "ENVIO CORREO DE PRUEBA"
Mensaje.FROM = "[email protected]"
Mensaje.addattachment (strFichero)
Mensaje.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
Mensaje.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.servidor.com"
Mensaje.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
Mensaje.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "pepito-servidor"
Mensaje.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "******"
Mensaje.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
Mensaje.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
Mensaje.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
Mensaje.Fields("urn:schemas:mailheader:disposition-notification-to") = "[email protected]"
Mensaje.Fields("urn:schemas:mailheader:return-receipt-to") = "[email protected]"
Mensaje.Configuration.Fields.Update
Mensaje.Send
MsgBox "Se ha enviado correctamente", vbInformation + vbOKOnly, "FICHERO EXPORTADO"
End Function

El e-mail se envia correctamenet, pero si el fichero que adjunto es un .xls o un .doc, da error al abrir. Adjuntando un pdf no da error. ¿alguien sabe la causa?

Hola mostren

Perdona por el mensaje anterior se fue solo

Te queria comentar que es muy frecuente que suceda esto, ya que por excel se puede disimular una Bomba de Tiempo, al igual que en Access y todo la suite Office que use VBE.

Algunos gestionadores de correos los estan rechazando. a menos que lo en comprimas y lo envies en ese formato.

en tu codigo, te recomiendo cambies la autentificacion a True para que el mensaje no llegue en la carpeta de los "no deseados".

Desde Venezuela
Jefferson

Antes de nada darte las gracias Jefferson, y para comprimir el fichero desde el codigo ¿como lo hago?

Ahorita no recuerdo como hacerlo, pero en san Google puedes encontrarlo.

Mas no veo la necesidad de hacerlo por codigo, ya que puedes hacerlo manual

Vere en que puedo ayudarte, voy a escudriñar en mis discos...

Desde Venezuea
Jefferson

Prueba a ver

http://sites.google.com/site/jjjt1973/Home/compacta-comprime-y-envia-por-correo

Solo debes destripar el codigo y adaptarlo a tus necesidades

Desde Venezuela
Jefferson

Hola Jefferson

Antes de intentar comprimir el fichero he mandado un .rar a traves del programa y al llegar al e-mail e intentar abrir el fichero da error "el archivo tiene un formato desconocido o esta dañado", por otra parte al cambiar a verdadero tal y como me has indicado el programa da error.

Un saludo

Hpña Mostren

Que gestionador de correo usas...????
Quizas sea este el problema, pues a mi no me manda ningun error..????

Desde Venezuela
Jefferson

Hola

Funciono con microsoft outlook.

Del programa de donde saque el codigo fuinciona perfectamente, lo copia y lo pego a ver si encontramos la diferencia.

Option Compare Database
Option Explicit
Enum ConstantesCorreoLibre
ConstanteCDOPuerto = 2
' Usar autentificacion básica.
ConstanteCDOA_Basica = 1
'Usar autentificación NTLM
ConstanteCDO_NTLM = 2 'NTLM
End Enum
Function EnviaCorreoLibre(StrServer As String, StrUsuario As String, _
strPassword As String, StrPara As String, StrOculto, StrDe As String, _
strAsunto As String, StrCuerpo As String, StrRutaAdjunto As String, StrRutaAdjunto1 As String, StrRutaAdjunto2 As String, StrRutaAdjunto3 As String, _
IntFormato As Integer, IntAviso As Integer, _
Optional AdornosHTML As String = "")
Dim ObjetoMensajeLibre As Object, strHTML As String
'Enviando Correo utilizando autentificación remota del server
' Creamos el objeto.
On Error GoTo EnviaCorreoLibre_Error
Set ObjetoMensajeLibre = CreateObject("CDO.Message")
' A quien va el mensaje. Para multimples destinos, separa las direcciones de correo por «;»
ObjetoMensajeLibre.To = StrPara
'copias ocultas
ObjetoMensajeLibre.BCC = Nz(StrOculto, "")
' Aquí va el asunto
ObjetoMensajeLibre.subject = Nz(strAsunto, "")

'Quien envía el correo. ! ojo ! solo funciona con esta sitaxis: NOmbre <[email protected]>
'es decir, por ejemplo: Juan Cots<[email protected]>
'Ojo al dato pues
ObjetoMensajeLibre.FROM = StrDe
'se rechaza si no se recibe una cadena tipo <[email protected]>

'Aqui va el cuerpo
ObjetoMensajeLibre.TextBody = Nz(StrCuerpo, "")

' Para fichero adjunto:
If Len(StrRutaAdjunto) <> 0 Then ObjetoMensajeLibre.addattachment ("file://" & StrRutaAdjunto)
If Len(StrRutaAdjunto1) <> 0 Then ObjetoMensajeLibre.addattachment ("file://" & StrRutaAdjunto1)
If Len(StrRutaAdjunto2) <> 0 Then ObjetoMensajeLibre.addattachment ("file://" & StrRutaAdjunto2)
If Len(StrRutaAdjunto3) <> 0 Then ObjetoMensajeLibre.addattachment ("file://" & StrRutaAdjunto3)
'End If

'****************************************************
'Aqui comienza en si las configuraciones del server de correo remoto
' ****************************************************

ObjetoMensajeLibre.Configuration.Fields.Item( _
"http://schemas.microsoft.com/cdo/configuration/sendusing") = _
ConstanteCDOPuerto

ObjetoMensajeLibre.Configuration.Fields.Item( _
"http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
StrServer

'Ahora especificamos el tipo de autentificacion que el server espera:

ObjetoMensajeLibre.Configuration.Fields.Item( _
"http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = _
ConstanteCDOA_Basica


ObjetoMensajeLibre.Configuration.Fields.Item( _
"http://schemas.microsoft.com/cdo/configuration/sendusername") = _
StrUsuario

ObjetoMensajeLibre.Configuration.Fields.Item( _
"http://schemas.microsoft.com/cdo/configuration/sendpassword") = _
strPassword

'Aqui el puerto. Casi siempre el 25.... asi que lo dejo a a piñon fijo
ObjetoMensajeLibre.Configuration.Fields.Item( _
"http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

'Si estas usando SSL para la conexión. Valores (False or True)
ObjetoMensajeLibre.Configuration.Fields.Item( _
"http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False

' Tiempo en segundos para que se establezca correctamente el protocolo SMTP.
ObjetoMensajeLibre.Configuration.Fields.Item( _
"http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
ObjetoMensajeLibre.Fields("urn:schemas:mailheader:disposition-notification-to") = StrDe 'ToDo: Type a valid e-mail address.
ObjetoMensajeLibre.Fields("urn:schemas:mailheader:return-receipt-to") = StrDe 'ToDo: Type a valid e-mail address.

' Guardamos....
ObjetoMensajeLibre.Configuration.Fields.Update

If IntAviso = 1 Then

End If

' Y ! POR FIN ! enviamos
DoCmd.OpenForm "Espere", , , , acFormReadOnly
DoCmd.Hourglass True
ObjetoMensajeLibre.Send
On Error GoTo 0
DoCmd.Close acForm, "Espere"
DoCmd.Hourglass False
MsgBox "Se ha enviado correctamente", vbInformation + vbOKOnly, "Envío Finalizado"
Exit Function
EnviaCorreoLibre_Error:
DoCmd.Close acForm, "Espere"
DoCmd.Hourglass False
MsgBox "Error " & Err.Number & " (" & Err.Description & ") en procedimiento EnviaCorreoLibre del Módulo EnvioAutomatico"
End Function

Por supuesto es mucho mas completo que mi adaptacion.

Hola Mostren

Si mal no recuerdo ese codigo es del Buho y adaptado por Juan Cost.....

Si analizamos en detenimiento tu primer codigo es casi lo mismo, en ambos casos se usa el componente Microsoft CDO for windows 2000 library.

El problema con este codigo, es que no deja pasar a GMAIL a menos que se modifique....

Ignoro para que estas haciendo esta aplicacion (Para ti mismo o Para Distribuirla) si es para ti esta bien ese codigo, ahora, si vas a distribuirla deberas pensar en que opciones darle a tus usuarios....

Mira este enlace
http://sites.google.com/site/jjjt1973/Home/enviar-correo-usando-cdo-de-una-forma-mas-sencilla

Ya comentaras
Desde Venezuela
Jefferson

hola Amigo es posible que me pueda explicar como ingresar este código en Access 2013 tengo una base donde hay un formulario llamado vacunas y tengo unos campos de fecha inicia y fecha final y me gustaría que cuando llegue la fecha final se envié al cliente un mensaje de acuerdo a las vacunas programadas. gracias por tu colaboración este es mi correo [email protected]