ENVIAR CORREO DESDE ACCESS USANDO SMTP

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

oCDO.Configuration.Fields( _

“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

oCDO.Configuration.Fields.Item _

(“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 )

oCDO.Configuration.Fields.Item _

(“http://schemas.microsoft.com/cdo/configuration/sendusername”) = nombre de usuario SMTP del servidor de correo

‘ Password de la cuenta

oCDO.Configuration.Fields.Item _

(“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

End If

Err.Clear

Screen.MousePointer = vbNormal

End Sub