Hola grupo.
Hace algún tiempo posteé sobre este mismo tema de envío de correos
con adjuntos desde excel.
Me enviaron a un enlace donde conseguí este código:
Private Sub CommandButton1_Click()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim cell As Range, FileCell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In
Sheets("Hoja1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And
Application.WorksheetFunction.CountA( _
Sheets("Hoja1").Cells(cell.Row, 1).Range("C1:F1")) > 0 Then
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = cell.Value
.Subject = "Testfile"
.Body = "Hi " & cell.Offset(0, -1).Value
'Enter the file names in the C:F column in each row
'You can make the range bigger if you want, only change
the column not the 1
For Each FileCell In Sheets("Hoja1").Cells(cell.Row,
1).Range("C1:F1") _
.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Display 'Or use Send
End With
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Tenemos:
A1=nombre - B1= email - C1= ruta fichero adjunto
A2=nombre - B2= email - C2= ruta fichero adjunto
A3=nombre - B3= email - C3= ruta fichero adjunto
Funciona bien en parte, ya que sólo envía el fichero adjunto indicado
en la ruta de C1. Evidentemente, en C2 y C3, también hay ruta y
fichero para enviar.
Alguna idea al respecto?
Saludos y gracias.
Paco.
Leer las respuestas