Envio de cooreos en excel

Te anexo una pequeña aplicación para enviar correos.

Estas macros van en los eventos de la hoja

Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
On Error Resume Next
If Not Intersect(Target, Range("B:B")) Is Nothing Then
    For Each t In Target
        If t.Value <> "" Then
            Cells(t.Row, "G").Select
            ActiveSheet.Hyperlinks.Add _
                Anchor:=Selection, _
                Address:="", _
                SubAddress:="Hoja1!C" & t.Row, _
                TextToDisplay:="Insertar archivo"
        End If
    Next
    Cells(Target.Row, 3).Select
End If
End Sub
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
'Por.Dante Amor
linea = ActiveCell.Row
col = Range("H1").Column
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Seleccione uno o varios archivos"
        .Filters.Clear
        .Filters.Add "archivos pdf", "*.pdf*"
        .Filters.Add "archivos de excel", "*.xls*"
        .Filters.Add "Todos los archivos", "*.*"
        .FilterIndex = 2
        .AllowMultiSelect = True
        .InitialFileName = ThisWorkbook.Path
        If .Show Then
            For Each ar In .SelectedItems
                'rutaarchivo = .SelectedItems.Item(i)
                Cells(linea, col) = ar
                col = col + 1
            Next
        End If
    End With
End Sub

Esta macro es para enviar los correo

'***Macro Para enviar correos
Sub correo()
'Por.Dante Amor
    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) 'Destinatarios
        dam.CC = Range("C" & i) 'Con copia
        dam.Bcc = Range("D" & i) 'Con copia oculta
        dam.Subject = Range("E" & i) '"Asunto"
        dam.body = Range("F" & i) '"Cuerpo del mensaje"
        '
        For j = col To Cells(i, Columns.Count).End(xlToLeft).Column
            archivo = Cells(i, j)
            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
End Sub

Te anexo el archivo, ya con las macros, en la hoja van unos comentarios para que pongas tu información y puedas enviar correos masivos.

https://www.dropbox.com/s/ybehb5osq0dxbh6/correo5a.xlsm?dl=0