VBA EXCEL Macro para enviar correos masivos

VBA EXCEL Macro para enviar correos masivos

   26 noviembre       Luis Reyes

---

En algunas ocasiones tenemos la tarea de enviar correos masivos, gracias a Excel ahora esa tarea es mucho mas sencillo, les comparto una macro para enviar correos masivos, para utilizar esta macro hay seguir los siguientes pasos:

1. Abrir Excel

2. Abrir el Editor de VBA.

3. Pegar el siguiente código:

Sub correo()

      For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        Set mail = CreateObject("outlook.application").createitem(0)
ruta = cells( i,6).value
cp = ruta
ChDir cp
arch = Dir(ruta & "\*.*")
        mail.To = Range("A" & i) 'Destinatarios
        mail.CC = Range("B" & i) 'Con copia
        mail.Bcc = Range("C" & i) 'Con copia oculta
        mail.Subject = Range("D" & i) '"Asunto"
        mail.body = Range("E" & i) '"Cuerpo del mensaje"
              
Do While arch <> ""
mail.Attachments.Add cp & "\" & arch ' Error
arch = Dir()
Loop

        'mail.send 'El correo se envía en automático
        mail.display 'El correo se muestra
    Next i
    MsgBox "Correos enviados", vbInformation, "SALUDOS"
End Sub

Descarga el archivo