Envios de estados de cuenta masivos

[David Diez]

Buen Día:

He hecho una macro para remitir estados de cuentas a clientes en forma masiva enlazando outlook con excel, en una hoja de excel he consignado los datos (nombre en la columna A, correo en la columna B y ruta del archivo a enviar en la columna C), está funcionando bien pero no adjunta el archivo adjunto de la ruta que doy, alguien podría ayudarme con esto, esta es la macro. Adjunto el excel con la data (sólo estoy probando con 2 datos, sin embargo pueden ser varios)

Sub Send_Files()

Dim OutApp As Object

Dim OutMail As Object

Dim sh As Worksheet

Dim cell As Range

Dim FileCell As Range

Dim rng As Range

With Application

.EnableEvents = False

.ScreenUpdating = False

End With

Set sh = Sheets("Sheet1")

Set OutApp = CreateObject("Outlook.Application")

For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")

If cell.Value Like "?*@?*.?*" And _

Application.WorksheetFunction.CountA(rng) > 0 Then

Set OutMail = OutApp.CreateItem(0)

With OutMail

.to = cell.Value

.Subject = "ESTADO DE CUENTA"

.Body = "Estimado (a) " & cell.Offset(0, -1).Value & " En el adjunto se detalla su estado de cuenta a la fecha, cualquier duda comuníquese con su sectorista"

For Each FileCell In rng.SpecialCells(xlCellTypeConstants)

If Trim(FileCell) <> "" Then

If Dir(FileCell.Value) <> "" Then

.Attachments.Add FileCell.Value

End If

End If

Next FileCell

.Send

End With

Set OutMail = Nothing

End If

Next cell

Set OutApp = Nothing

With Application

.EnableEvents = True

.ScreenUpdating = True

End With

End Sub

ENVIOS EECC MASIVOS PRUEBA.xls