Tengo una macro para envío masivo de correos con adjuntos, necesito indicarle que envíe 2 archivos, mismo nombre, diferente ext
Tengo una macro para el envío masivo de correos electrónicos con adjuntos, necesito indicarle que envíe 2 archivos, mismo nombre, diferente extensión, me pueden ayudar por favor
Sub EnviarMails2()
Dim App As Object
Dim Mail As Object
Sheets("Mails").Select
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
Set App = CreateObject("Outlook.Application")
App.Session.Logon
Set Mail = App.CreateItem(0)
On Error Resume Next
With Mail
.To = Range("A" & i).Value
.CC = Range("B" & i).Value
.BCC = Range("C" & i).Value
.Subject = Range("D" & i).Value
.Object = Range("E" & i).Value
.Attachments.Add Range("F" & i).Value
'.Send
.Display
End With
Set Mail = Nothing
Next
End Sub
2 Respuestas
Revisa lo siguiente para enviar correos masivos, tal vez te puede interesar:
Enviar correos masivos - YouTube
Sal u dos Dante Amor
Aquí tienes el código actualizado para enviar dos archivos adjuntos con el mismo nombre pero diferente extensión
Sub EnviarMails2()
Dim App As Object
Dim Mail As Object
Dim Adjunto1 As String
Dim Adjunto2 As String
Sheets("Mails").Select
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
Set App = CreateObject("Outlook.Application")
App.Session.Logon
Set Mail = App.CreateItem(0)
On Error Resume Next
With Mail
.To = Range("A" & i).Value
.CC = Range("B" & i).Value
.BCC = Range("C" & i).Value
.Subject = Range("D" & i).Value
.Object = Range("E" & i).Value
' Obtener los nombres de los archivos adjuntos
Adjunto1 = Range("F" & i).Value & ".ext1"
Adjunto2 = Range("F" & i).Value & ".ext2"
' Adjuntar los archivos
. Attachments. Add Adjunto1
. Attachments. Add Adjunto2
'. Send
. Display
End With
Set Mail = Nothing
Next
End Sub