Adjuntar varios archivos y enviar a varios correos en Excel

Dante amor, tengo esta macro y deseo adjuntar archivos cuya dirección se encuentran en la columna "Q", para cada email se adjuntará diferentes archivos pdf.

--------------------------------------------------------

Private Sub Workbook_Open()

'Por.Dante Amor
Set h = Sheets("control")
For i = 7 To h.Range("H" & Rows.Count).End(xlUp).Row
If IsDate(h.Cells(i, "H")) And h.Cells(i, "I") = "" And h.Cells(i, "CA") = "" Then
dia = WorksheetFunction.WorkDay(h.Cells(i, "H"), -5)
If Date >= dia Then
'enviar correo
h.Cells(i, "CA") = "x"
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = h.Cells(i, "N") & ";" & h.Cells(i, "O") & ";" & h.Cells(i, "P") 'Destinatarios
dam.Subject = "RESPUESTA A DOCUMENTO POR VENCER " & _
h.Cells(i, "F") & "-" & h.Cells(i, "E") '"Asunto"
dam.Body = "Estimado " + vbNewLine & _
h.Cells(i, "A") + vbCrLf + vbCrLf & _
"Es para hacerle recordar que para dar respuesta al documento " & _
h.Cells(i, "F") & " - " & h.Cells(i, "E") & " - " & h.Cells(i, "D") & ", " & _
" tiene plazo hasta el " & _
h.Cells(i, "H") & ". " + vbNewLine & _
"Atentamente " + vbNewLine & _
"La Jefatura "
dam.Send
End If
End If
Next
End Sub

2 respuestas

Respuesta
1

Yo uso la siguiente macro

Sub correo_1()
Dim mi_App As Object
Dim mi_Correo As Object
    i = 1
    Do
      i = i + 1
    Set mi_App = CreateObject("Outlook.Application")
    mi_App.Session.logon
    Set mi_Correo = mi_App.CreateItem(0)
    ActiveWorkbook.Save
    On Error Resume Next
    With mi_Correo
    .SentOnBehalfOfName = "[email protected]"
    .To = Range("B" & i).Value
    .CC = Range("C" & i).Value
    .BCC = Range("D" & i).Value
    .Subject = Range("E" & i).Value
    .Body = Range("F" & i).Value
    .Attachments.Add Range("G" & i).Value
    .Attachments.Add Range("H" & i).Value
    .DeleteAfterSubmit = False
    .Send
    End With
    'MsgBox "Email enviado con éxito"
    On Error GoTo 0
    Set mi_Correo = Nothing
    Set mi_App = Nothing
 Loop Until i = 3
End Sub
Respuesta
1

Puedes descargar de google drive mi archivo con algunas otras opciones:

Macro para envíar correos masivos con adjuntos diferentes

Gracias Dante amor por tu tiempo, casualmente estoy utilizando esta macro y funciona perfectamente al enviar correo a todos de la lista

Pero si solo quiero enviar correo al 1° al 3° y 5° aparece el siguiente error  -2147467259 (80004005).   Gracias de antemano por tu ayuda.

No entiendo a qué te refieres con "correo al 1° al 3° y 5° "

Puedes poner aquí el código que utilizas.

Qué dice el mensaje de error y en cuál línea se detiene la macro.

También puedes poner una imagen aquí de una muestra de tus datos. Si es información confidencial, cambia por datos genéricos.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas