Problemas con la Macro para enviar correos masivos con adjuntos diferentes

En este momento estoy tratando de poner en marcha la macro para enviar correos masivos de autoria de Dante Amor, pero la macro me arroja error cuando la ejecuto.

Esta es la Macro que tengo

'***Macro Para enviar correos
Sub correo()
'Por.Dam
ufila = Range("B" & Rows.Count).End(xlUp).Row
col = Range("H1").Column
For i = 2 To ufila
Set dam1 = CreateObject("outlook.application")
Set dam2 = dam1.CreateItem(olMailItem)
dam2.To = Range("B" & i) 'Destinatarios
dam2.CC = Range("C" & i) 'Con copia
dam2.Bcc = Range("D" & i) 'Con copia oculta
dam2.Subject = Range("E" & i) '"Asunto"
dam2.body = Range("F" & i) '"Cuerpo del mensaje"
ucol = Cells(i, Columns.Count).End(xlToLeft).Column
For j = col To ucol
archivo = Cells(i, j)
If archivo <> "" Then dam2.Attachments.Add archivo
Next
dam2.Send 'El correo se envía en automático
'dam2.display 'El correo se muestra
Next
End Sub

Pero al ejecutarla me arroja el siguiente error

Hice la prueba que Dante Amor le sugirió a otra persona
Sub EnviarCorreo()
'Por.Dante Amor
    Set dam = CreateObject("outlook.application").CreateItem(0)
    dam.Display 'El correo se muestra
End Sub

El resultado de la prueba fue que se abrió una ventana con un correo nuevo.

También verifique que la librería de outlook estuviera activa

Adicional también puse a correr la siguiente macro que alguien sugirió como prueba.
Sub SendEmail()
Dim mlook As Outlook.MailItem
Set mlook = Outlook.Application.CreateItem(olMailItem)
mlook.To = "[email protected]"
mlook.Subject = "test"
mlook.Send
End Sub

 El resultado de la prueba fue el siguiente cuadro de dialogo.

Al dar click en permitir se envía el correo efectivamente.

Espero que me puedas ayudar, pues esta herramienta seria de muchísima utilidad para mi trabajo.

1 Respuesta

Respuesta
2

H   o l a :

Te anexo la macro actualizada

Sub correo()
'Por.Dam
    ufila = Range("B" & Rows.Count).End(xlUp).Row
    col = Range("H1").Column
    For i = 2 To ufila
        Set dam1 = CreateObject("outlook.application")
        Set dam2 = dam1.CreateItem(olMailItem)
        dam2.To = Range("B" & i).Value 'Destinatarios
        dam2.CC = Range("C" & i).Value 'Con copia
        dam2.Bcc = Range("D" & i) 'Con copia oculta
        dam2.Subject = Range("E" & i).Value '"Asunto"
        dam2.body = Range("F" & i).Value '"Cuerpo del mensaje"
        ucol = Cells(i, Columns.Count).End(xlToLeft).Column
        For j = col To ucol
            archivo = Cells(i, j).Value
            If archivo <> "" Then dam2.Attachments.Add archivo
        Next
    dam2.Send 'El correo se envía en automático
    'dam2.display 'El correo se muestra
    Next
End Sub

El detalle de la ventana para "Permitir", es un parámetro en la configuración de seguridad de microsoft Outlook, no se puede desactivar desde la macro.

Revisa en la red, para desactivar esa seguridad: "Un programa intenta enviar un correo ..."


Si te funciona el envío de correo, recuerda valorar la respuesta.

¡Gracias! Dante la macro funciona a la perfección solamente le agregue a esta línea el .value

 dam2.Bcc = Range("D" & i) 'Con copia oculta

Un millón de gracias, por compartir tus conocimientos.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas