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.