VBA Enviar Emails desde Excel A Través de Gmail

Este tutorial le mostrará cómo enviar correos electrónicos desde Excel a través de Gmail utilizando VBA.

Adición de la Referencia CDO de Microsoft

Para permitir que Excel envíe correos electrónicos a través de Gmail, primero debe agregar la biblioteca de referencia CDO a su proyecto de Excel. En el Editor VBA, haz clic en Herramientas, Referencias.

Busque la Referencia Microsoft CDO y haga clic en Aceptar.

Enviando un Email A Través de GMail

Para enviar un correo electrónico desde Excel a través de Gmail, primero debe declarar un objeto CDO(Dim gMail as CDO.Message).

En segundo lugar, tendrá que configurar la autenticación SSL para su mensaje en el código. Esto significa que necesita configurar el servidor SMTP y los detalles del puerto para que su correo electrónico se envíe correctamente, así como configurar su nombre de usuario y contraseña.

En el siguiente fragmento de código, esto es lo que necesitaría al principio de su función de Excel. Necesita un Destinatario de Email (strTo), y un Asunto (strSubject) pero el CC y el Cuerpo del email pueden ser variables opcionales.

Function CreateEmail(strTo As String, strSubject As String, Optional strCC As String, Optional strBody As String)

'crear un objeto CDO
   Dim gMail As CDO.Message
   Set gMail = New CDO.Message

'Activar autenticación SSL
   gMail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

'Hacer autenticación SMTP Enabled=true (1)
   gMail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1

'Establezca el servidor SMTP y el puerto Detalles
   gMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
   gMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
   gMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

'Establece tu nombre de usuario y contraseña para tu propia cuenta de gmail aquí
    gMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "johnsmith@gmail.com"
   gMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "*********"

'Actualizar los campos de configuración
   gMail.Configuration.Fields.Update

Una vez hecho esto, puede crear su correo electrónico y completar la función.

'establecer las propiedades del correo electrónico y el archivo a enviar
   With gMail
      .Subject = "Escriba aquí el asunto"
      .From = "stitchmel@gmail.com"
      .To = strTo
      .TextBody = strBody
   End With
'enviar el correo
   gMail.Send
End Function

A continuación, puede llamar a su función con el siguiente código

Sub SendEmail()
'crear el cuerpo del correo electrónico
Dim strText As String
   strText = "Good morning.  Hope you are well - this is a test email"
'rellenar los argumentos de la función - dejar CC en blanco por lo que poner una coma como marcador de posición
   Call CreateEmail("jimsmith@gmail.com", "Test Email", "", strText)
End Sub

Envío de un Libro de Trabajo A Través de GMail

Para enviar un libro de trabajo como un archivo adjunto a través de GMail, puede crear una función muy parecida a la anterior con algunas adiciones.

Es necesario añadir código para seleccionar el libro de trabajo y, a continuación, adjuntar el archivo seleccionado al correo electrónico.

Utilizaremos el comando Microsoft Office FileDialog para seleccionar el archivo a enviar, y luego utilizaremos la propiedad AddAttachment del correo electrónico para añadir el archivo como adjunto.

Function SendWorkbook(strTo As String, strSubject As String, Optional strCC As String, Optional strBody As String) As Boolean
On Error GoTo eh:

'crear un objeto CDO
   Dim gMail As CDO.Message
   Set gMail = New CDO.Message

'Activar autenticación SSL
   gMail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

'Hacer autenticación SMTP Enabled=true (1)
   gMail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1

'Establezca el servidor SMTP y el puerto Detalles
   gMail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
    gMail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
   gMail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

'Establece tu nombre de usuario y contraseña para tu propia cuenta de gmail aquí
   gMail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/sendusername") = "johnsmith@gmail.com"
   gMail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "*********"

'Actualizar los campos de configuración
   gMail.Configuration.Fields.Update

'seleccione el archivo que desea enviar con el cuadro de diálogo de archivos de microsoft
   Dim strFileToSend As String
   Dim dlgFile As FileDialog
   Dim strItem As Variant
   Dim nDlgResult As Long
   Set dlgFile = Application.FileDialog(msoFileDialogFilePicker)
'filtro sólo para archivos excel y csv
   dlgFile.Filters.Add "Excel Files", "*.csv; *.xls; *.xlsx; *.xlsm"
   nDlgResult = dlgFile.Show
   If nDlgResult = -1 Then
      If dlgFile.SelectedItems.Count > 0 Then
         For Each strItem In dlgFile.SelectedItems
             strFileToSend = strItem
         Next strItem
      End If
   End If
'establecer las propiedades del correo electrónico y el archivo a enviar
   With gMail
     .Subject = "Write subject here"
     .From = "stitchmel@gmail.com"
     .To = strTo
     .TextBody = strBody
'añadir el archivo seleccionado como adjunto
     .AddAttachment strFileToSend
   End With
'enviar el correo
   gMail.Send
   SendWorkbook = True
   Exit Function
eh:
   SendWorkbook = False
End Function

Si el puerto de configuración 25 no funciona puede que obtenga un error – «The transport failed to connect to the server» Cambie el puerto a 25 e inténtelo de nuevo. La función de arriba puede ser llamada usando el procedimiento de abajo.

Sub SendMail()
   Dim strTo As String
   Dim strSubject As String
   Dim strBody As String
'rellenar variables
   strTo = "jon.smith@gmail.com"
   strSubject = "Please find finance file attached"
   strBody = "some text goes here for the body of the email"
'llamar a la función para enviar el correo electrónico
   If SendWorkbook(strTo, strSubject, , strBody) = True Then
      MsgBox "Email creation Success"
   Else
      MsgBox "Email creation failed!"
   End If
End Sub

Se le pedirá que seleccione el archivo que desea enviar. Este código está restringido a ficheros Excel debido a que el filtro es «*.csv; *.xls; *.xlsx; *.xlsm» – sin embargo, también puede utilizar este código dentro de Word, y modificar su filtro en consecuencia.

Seleccione el archivo y haga clic en Abrir. El código puede tardar un poco en ejecutarse – si el correo se envía correctamente, aparecerá el siguiente mensaje.