Si queremos enviar correos personalizados desde una aplicacion en Access u otro programa que haga uso de VBA lo haremos de la siguiente manera, este ejemplo en particular hace uso de un servidor SMTP externo con autentificacion.
Primero creamos una funcion para leer la plantilla (en el caso de que la tengamos) que va a contener el html de nuestro email, logicamente devolvera un string.
Para que el objeto Scripting.FileSystemObject pueda ser usado primero debemos añadir la referencia “Microsoft Scripting Runtime” , sino nos dara algun fallo como que no reconoce el tipo.
Public Function LeeFichero() As String
Dim fso As Scripting.FileSystemObject, fil1 As File, ts As TextStream
Dim strPath2 As String
strPath2 = “C:\html_email.txt”
Set fso = New Scripting.FileSystemObject
Set fil1 = fso.GetFile(strPath2) ‘ strPath2 contiene el nombre completo del fichero
Set ts = fil1.OpenAsTextStream(ForReading, TristateUseDefault)
Do Until ts.AtEndOfStream
Dim sTexto As String
sTexto = sTexto & vbCrLf & ts.ReadLine
Loop
ts.Close
LeeFichero = sTexto
Set ts = Nothing
Set fil1 = Nothing
Set fso = Nothing
End Function
Luego creamos un procedimiento que recibira por parametros el remitente, destinatario y texto que queremos enviarle
Sub envia_correo(remitente, destinatario, texto)
‘ Variable de objeto Cdo.Message
Dim oCDO As Object
‘ Crea un Nuevo objeto CDO.Message o lo que es lo mismo agregamos la libreria Activex Microsoft CDO “Microsoft CDO for windows 2000 library”
Set oCDO = CreateObject(“CDO.Message”)
‘ Indica el servidor Smtp para poder enviar el Mail ( puede ser el nombre del servidor o su dirección IP )
oCDO.Configuration.Fields( _
“http://schemas.microsoft.com/cdo/configuration/smtpserver”) =IP del servidor de correo o nombre ej. mail.tudominio.com
“http://schemas.microsoft.com/cdo/configuration/sendusing”) = 2
‘ Puerto. Por defecto se usa el puerto 25,en el caso de Gmail se usa el puerto 465
oCDO.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/smtpserverport”) = 25
‘ Indica el tipo de autentificación con el servidor de correo El valor 0 no requiere autentificarse, el valor 1 es con autentificación
oCDO.Configuration.Fields.Item(“http://schemas.microsoft.com/cdo/” & _
“configuration/smtpauthenticate”) = 1
‘ Tiempo máximo de espera en segundos para la conexión
(“http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout”) = 10
‘ Configura las opciones para el login en el SMTP
‘ Id de usuario del servidor Smtp ( en el caso de gmail, debe ser la dirección de correro mas el @gmail.com )
(“http://schemas.microsoft.com/cdo/configuration/sendusername”) = nombre de usuario SMTP del servidor de correo
‘ Password de la cuenta
(“http://schemas.microsoft.com/cdo/configuration/sendpassword”) = password del SMTP
‘ Estructura del mail
”””””””””””””””””””””””’
‘ Dirección del Destinatario
oCDO.To = destinatario
‘ Dirección del remitente
oCDO.From = remitente
‘ Asunto del mensaje
oCDO.Subject = “Prueba”
‘ Cuerpo del mensaje
‘Aqui sustituimos una etiqueta que habiamos metido en la plantilla html por el texto que queremos enviar
oCDO.HTMLBody = Replace(LeeFichero, “[mensaje]”,texto)
‘ Actualiza los datos antes de enviar
oCDO.Configuration.Fields.Update
On Error Resume Next
DoCmd.Hourglass True
‘ Envía el email
oCDO.Send
Screen.MousePointer = 0
‘ .. si no hubo error
If Err.Number = 0 Then
Enviar_Correo = True
MsgBox “Enviado”
ElseIf Err.Number = -2147220973 Then
MsgBox (“Posible error : nombre del Servidor incorrecto o número de puerto incorrecto” & Err.Number)
ElseIf Err.Number = -2147220975 Then
MsgBox (“Posible error : error en la el nombre de usuario, o en el password ” & Err.Number)
Else
MsgBox (Err.Description & Err.Number)
End If
‘ Descarga la referencia
If Not oCDO Is Nothing Then
Set oCDO = Nothing
Err.Clear
Screen.MousePointer = vbNormal
End Sub