Macros enviar emails con adjuntos

Para eso tengo una aplicación, para enviar varios correos, para diferentes destinatarios, con diferentes asuntos, cuerpos y adjuntos.

La macro para outlook es esta:

Sub Enviar_Correos()
'---
'   Por.Dante Amor
'---
    '***Macro Para enviar correos
    col = Range("H1").Column
    For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
        Set dam = CreateObject("Outlook.Application").CreateItem(0)
        '
        dam.To = Range("B" & i).Value           'Destinatarios
        dam.Cc = Range("C" & i).Value           'Con copia
        dam.Bcc = Range("D" & i).Value          'Con copia oculta
        dam.Subject = Range("E" & i).Value      '"Asunto"
        dam.Body = Range("F" & i).Value         '"Cuerpo del mensaje"
        '
        For j = col To Cells(i, Columns.Count).End(xlToLeft).Column
            archivo = Cells(i, j).Value
            If archivo <> "" Then dam.Attachments.Add archivo
        Next
        Dam. Send 'El correo se envía en automático
 'dam. Display 'El correo se muestra
    Next
    MsgBox "Correos enviados", vbInformation, "SALUDOS"
End Sub

Envíame un correo para enviarte el archivo con ejemplos.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Eduardo Barragan” y el título de esta pregunta.

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.