Envío mail desde Access 2010 a Gmail (con dominio propio)
Hola a todas/os,
Tengo el siguiente código en Access 2010 que realiza un envío desde dicha bd a Lotus Notes recogiendo datos de una consulta, agregándolos a los campos correspondientes.
Quiero poder adaptarlo para poder enviarlo a correo Gmail cuyo dominio es de la empresa:
Public Sub Envio_Click()
On Error GoTo sol_err
Dim vMail As Variant 'no se puede
'declarar como String porque los valores nulos del objeto ‘recordset no los
'reconoce
Dim Mensaje As Variant
Dim Asunto As String
Dim OutApp As Object
Dim db As Object
Dim rst As Recordset
'Comprobamos el día de la semana, sino es lunes (valor 1) salimos
'Si es lunes creamos el recordset
Set rst = CurrentDb.OpenRecordset("Incidencias diarias")
'Nos movemos al primer registro
rst.MoveFirst
'Iniciamos el recorrido de registros
Do Until rst.EOF
'Cogemos el valor del destinatario
vMail = rst.Fields("Mail").Value
'Si no existiera el mail pasamos al siguiente registro
If IsNull(vMail) Then GoTo
Siguiente
'Lotus Notes tiene que estar abierto y desbloqueado en
el momento de abrir la bd porque sino no realiza el envío
Set OutApp =
CreateObject("Notes.NotesSession")
Set db =
OutApp.GETDATABASE("", "names.nsf")
Set doc = db.CREATEDOCUMENT()
doc.SAVEMESSAGEONSEND = True
Asunto = "Empresa"& rst.Fields("EMPRESA") & "de hoy "&Format(Date, "dd/mm/yy ")
doc.Subject = Asunto
Mensaje = "La empresa:"& rst.Fields("EMPRE").Value & " ha generado a fecha " & rst.Fields("FAveria").Value
Mensaje = Mensaje &" la siguiente incidencia: " & (Chr(13)) & (Chr(13)) &
"Número: " & rst.Fields("NParte").Value & (Chr(13))& (Chr(13))
Mensaje = Mensaje &"Albarán: " & rst.Fields("Albarán").Value &
(Chr(13)) & (Chr(13)) & " Descripción: " & (Chr(13))& rst.Fields("Descripción").Value & (Chr(13)) & (Chr(13))& " Un Saludo"
doc.body = Mensaje
Call doc.Send(False, vMail) 'lanzamos el mail
Siguiente: 'nos movemos al registro siguiente
rst.MoveNext
Loop
Salida:
'cerramos conexiones y liberamos memoria
rst.Close
Set OutApp = Nothing
Set doc = Nothing
Set rst = Nothing
Exit Sub
sol_err:
Resume Salida
End Sub
Muchas gracias anticipadas por la ayuda. No se como adaptar este código a Gmail. Si bien, con Lotus notes instalado en un ordenador funciona perfectamente. Pero deseo poder usar este nuevo servidor de google y con dominio propio de la empresa.
Saludos
Rosa