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)
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