Enviar correo de gemail desde registro Access con datos adjuntos y sin pasar por outlook
Nuevamente recurro a vuestro superior conocimiento en demanda de ayuda.
Me gustaría saber si hay algún código que permita el envío de correo electrónico desde Access, sin tener que pasar por Outlook. Llevo varios días mirando ejemplos en internet, he probado de varias formas, He configurado mi correo para que permita el acceso de aplicaciones poco seguras, pero no consigo hacer que funcione.
¿Alguna sugerencia?
1 Respuesta
Yo conozco ésta que explica Neckkito y sé que funciona: http://neckkito.xyz/nck/index.php/ejemplos/18-codigo/164-y-tres-de-mail
Gracias amigo, me lo estudio y ya te cuento.
Hola de nuevo.
Antes de nada te agradezco que me indicases el ejemplo de Neckkito', al que también debemos agradecer , como no, ese magnifico trabajo que puso a disposición de la comunidad.
He probado los tres ejemplos adaptandolos a BD y realmente funcionan.
Pero lo ideal seria unificar los tres en un solo formulario, yo lo he intentado y no he sido capaz de hacerlo.
A este Formulario le he puesto este código:
Private Sub Buscar_Archivo_Click()
Call ruta
End Sub
Private Sub cmdCerrar_Click()
On Error GoTo Err_cmdCerrar_Click
If Me.Dirty Then Me.Dirty = False
DoCmd.Close
Exit_cmdCerrar_Click:
Exit Sub
Err_cmdCerrar_Click:
MsgBox Err.Description
Resume Exit_cmdCerrar_Click
End Sub
Private Sub Comando16_Click()
Me.Lista_Correos.Visible = True
End Sub
Private Sub Enviar_Click()
'Ejemplo para utilizar con GMail!!!!!!
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 = "secretario"
Const miSmtp As String = "smtp.gmail.com"
'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.TxtMensaje.Value, "")
mailA = Nz(Me.txtDestino.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
'Indicamos la ubicación del archivo que queremos enviar
Dim MiArchivo As String
MiArchivo = Nz(Me.TxtArchivo.Value, "")
'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") = True
.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://" & MiArchivo
If Not IsMissing(MiArchivo) 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 MiArchivo
Salida:
Exit Sub
sol_err:
MsgBox Err.Number & ": " & Err.Description
Resume Salida
End Sub
Private Sub Limpiar_Click()
Me.txtDestino.Value = Null
Me.TxtAsunto.Value = Null
Me.TxtArchivo.Value = Null
Me.TxtMensaje.Value = Null
End Sub
Private Sub Lista_Correos_Click()
Me.txtDestino = Me.Lista_Correos.Column(1)
End Sub
Private Sub ruta()
Dim dialogo As Office.FileDialog
Dim ObtenRuta As String
On Error Resume Next
Set dialogo = Application.FileDialog(msoFileDialogFilePicker)
With dialogo
.Title = "Selecione un archivo"
.Filters.Add "All Files", "*.*"
.AllowMultiSelect = False
.InitialFileName = CurrentProject.Path
If (.Show <> 0) Then
ObtenRuta = Trim(.SelectedItems.ITEM(1))
Me.TxtArchivo = ObtenRuta
End If
End With
Salir:
Exit Sub
Con este código funciona perfectamente para enviar un mail con un archivo adjunto, a un solo destinatario.
Problemas que se me plantean:
1.- Si el Campo "ARCHIVO" está vacío, da error. Dice que no encuentra la ruta y no envía el mensaje, con lo que nos obliga a enviar un adjunto.
2.- Solo Permite el envió a un destinatario,.- Lo ideal sería poder declarar los destinatarios, según necesidades del usuario.
3.- Solo permite el envío de un archivo adjunto, También en este caso, lo ideal seria poder adjuntar archivos en función de las necesidades del usuario.
En fin amigo, perdona que te caliente la cabeza con este asunto, pero si pudieras orientarme sobre las modificaciones que pudiera hacer para darle al formulario todas las funcionalidades que nos describe Neckkito en su ejemplo.y aglutinarlas todas en un único formulario, haríamos un gran trabajo. GRACIAS.
Te respondo:
1º/ Si no hay adjunto no te debería dar ningún error, porque eso ya lo controla esta parte:
Dim miAdjunto As String miAdjunto = "file://" & MiArchivo If Not IsMissing(MiArchivo) Then msgOne.AddAttachment (miAdjunto) End If
El problema está, creo yo, en estas dos lineas que has añadido antes, al haber usado el Nz:
Dim MiArchivo As String MiArchivo = Nz(Me.TxtArchivo.Value, "")
En cualquier caso, puedes realizar una validación adicional con:
If Len(MiArchivo)>0 Then Dim miAdjunto As String miAdjunto = "file://" & MiArchivo If Not IsMissing(MiArchivo) Then msgOne.AddAttachment (miAdjunto) End If End If
3º/ Para enviar más adjuntos, lo más sencillo sería añadir más cuadros en los que cargar los archivos y repetir las lineas anteriores con cada cuadro de texto.
La opción complicada sería hacer algo como lo que explico en le ejemplo "Simulador de datos adjuntos": tendrías que encadenar en un cuadro de texto todos los adjuntos, separados por algún carácter, y luego separarlos, por ejemplo con la función Split(), hacer un bucle que los recorra todos y dentro de ese bucle, poner las lineas que cargan los adjuntos. Como digo, se puede hacer, pero no es cosa de copiar dos lineas de código...
2º/ Para poder enviar a más de un destinatario, tienes que modificar el cuadro de lista para permitir "selección múltiple", y luego recorrer con un bucle todos los elementos seleccionados y encadenar todas las direcciones separadas por ";" en el cuadro de texto TxtDestino
En cualquier caso, ya no te valdría el evento "al hacer click" del cuadro de lista para pasar las direcciones al cuadro de texto, necesitarías un botón con un código como éste:
Dim ctlList As Control Dim Opcion As Variant Dim miSeleccion As String Set ctlList = Me.Lista_Correos For Each Opcion In ctlList.ItemsSelected miSeleccion = miSeleccion & ctlList.Column(1, Opcion) & ";" Next Opcion Me.TxtDestino= miSeleccion
