Como enviar email masivo con archivos adjuntos diferentes con excel
"para Dante Amor". Hola. Necesito enviar un email masivo con archivos adjuntos diferentes para cada destinatario. Ademas, el cuerpo del email contiene una carta con logo de empresa y firma digital. ¿Tienes alguna plantilla?
Es decir, tengo estos datos en un excel y quiero adjuntar a cada destinatario es adjunto correspondiente :
H o l a:
¿El correo es por otulook?
Tengo una aplicación para enviar correos masivos con logo y una firma.
Pero no sé a qué te refieres con "firma digital"
Pon esta macro en un módulo:
'***Macro Para enviar correos con adjunto diferente y firma
Sub correo()
'Por.Dante Amor
col = Range("H1").Column
ruta = ThisWorkbook.Path & "\"
For i = 3 To Range("B" & Rows.Count).End(xlUp).Row
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = Range("B" & i) 'Destinatarios
dam.CC = Range("C" & i) 'Con copia
dam.Bcc = Range("D" & i) 'Con copia oculta
dam.Subject = Range("E" & i) '"Asunto"
Cuerpo = Range("F" & i) '"Cuerpo del mensaje"
'
For j = col To Cells(i, Columns.Count).End(xlToLeft).Column
archivo = Cells(i, j)
If archivo <> "" Then dam.Attachments.Add archivo
Next
'
logo = [L2]
dam.Attachments.Add ruta & logo
dam.HTMLBody = _
"<HTML> " & _
"<BODY>" & _
"<P>" & Cuerpo & "</P>" & _
"<img src=cid:" & logo & " height=40 width=40>" & _
"<br>" & "<b>" & [I2] & "</b>" & _
"<br>" & [J2] & _
"<br>" & [K2] & _
"</BODY> " & _
"</HTML>"
'dam.Display 'El correo se muestra
dam.send 'El correo se envía en automático
Next
MsgBox "Correos enviados", vbInformation, "SALUDOS"
End SubPon esta macro en los eventos de la hoja:
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
On Error Resume Next
If Target.Count > 1 Then Exit Sub
If Target.Row < 3 Then Exit Sub
If Not Intersect(Target, Range("B:B")) Is Nothing Then
For Each t In Target
If t.Value <> "" Then
Cells(t.Row, "G").Select
ActiveSheet.Hyperlinks.Add _
Anchor:=Selection, _
Address:="", _
SubAddress:="Hoja1!C" & t.Row, _
TextToDisplay:="Insertar archivo"
End If
Next
Cells(Target.Row, 3).Select
End If
End Sub
'
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
'Por.Dante Amor
linea = ActiveCell.Row
'col = Range("H1").Column
col = Cells(linea, Columns.Count).End(xlToLeft).Column + 1
If col < 8 Then col = 8
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione uno o varios archivos"
.Filters.Clear
.Filters.Add "archivos pdf", "*.pdf*"
.Filters.Add "archivos de excel", "*.xls*"
.Filters.Add "Todos los archivos", "*.*"
.FilterIndex = 2
.AllowMultiSelect = True
.InitialFileName = ThisWorkbook.Path & "\"
If .Show Then
For Each ar In .SelectedItems
'rutaarchivo = .SelectedItems.Item(i)
Cells(linea, col) = ar
col = col + 1
Next
End If
End With
End SubLos datos los tienes que poner de esta forma:
':) ':)
Muchas gracias! Pero siento mi ignorancia. ¿Me puedes dar unas instrucciones para insertar las macros en los módulos y en los eventos? ¿Dónde me puedo descargar el excel de tu ultima imagen?
Perdona mi ignorancia pero es que no estoy acostumbrado trabajar con macros
GRacias
Otra pregunta, se puede vicnualar este excel mediante combinacion de correspondecia del word?
Es decir, yo tengo una carta con un word y lo que hacia antes es combinar correspondencia y se enviaban esta carta como cuerpo del email a unos 50 destinatarios diferentes sin adjuntos.
Pero necesito hacer lo mismo pero adjuntando un archivo externo diferente para cada destinatario automaticamente
Es posible?
Envíame un correo para enviarte el archivo.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Andreu Alcover” y el título de esta pregunta.
