Enviar mail desde excel con una firma y adjuntos
Tengo una macro de excel, que envía mail con un determinado asunto y cuerpo del mensaje a unos determinados correos que vienen definidos en una columna y quiero completarla insertando una firma siempre que la ejecute, y predefininiendo que adjunte en cada mail diciéndole la ruta el archivo que comienza con el nombre de una determinada columna
La macro es la siguiente:
'***Macro Para enviar detalles de facturaciones
Sub correo()
'definimos la columna donde va a ir el adjunto
col = Range("H1").Column
For i = 2 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"
dam.body = 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
'dam.send 'El correo se envía en automático
dam.display 'El correo se muestra
Next
MsgBox "Correos realizados", vbInformation, "
1 Respuesta
Te anexo la nueva versión de las macro para enviar correo con firma.
Los datos de la firma los tienes que poner en las celdas I2, J2 y K2.
Al igual que la versión anterior puedes enviar diferentes archivos a cada destinatario.
La salida con la firma en HTML se verá así:
Estas macros van 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 SubEsta macro va en el módulo:
[code]'***Macro Para enviar correos con adjunto diferente y firmaSub correo()
'Por.Dante Amor
col = Range("H1").Column
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
'
dam.HTMLBody = _
"<HTML> " & _
"<BODY>" & _
"<P>" & Cuerpo & "</P>" & _
"<table border>" & _
"<tr> <th>" & _
[I2] & _
"</th> </tr>" & _
"<tr> <td>" & _
[J2] & _
"</td> </tr>" & _
"<tr> <td>" & _
[K2] & _
"</td> </tr>" & _
"</table>" & _
"</BODY> " & _
"</HTML>"
dam.Display 'El correo se muestra
'dam.send 'El correo se envía en automático
Next
MsgBox "Correos enviados", vbInformation, "
Hola, la firma es con el formato tipo excel, es decir con una imagen corporativa, una opción podría ser pegar una imagen con la misma,,, es decir quiero mi firma del correo no me vale con texto
Y el adjunto sería poner una carpeta determinada y algún comodín que me valiera para todos los meses es decir en que no tuviera que linkarlo cada mes sino que apuntara a una carpeta con el inicio del fichero y lo cogiera automáticamente
Envíame un ejemplo de lo que quieres como firma, de lo contrario no puedo saberlo.
Te anexo la macro para enviar correos con la imagen en la firma.
[code]'***Macro Para enviar correos con adjunto diferente y firmaSub 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
'
dam.Attachments.Add ruta & "orange.jpg"
dam.HTMLBody = _
"<HTML> " & _
"<BODY>" & _
"<P>" & Cuerpo & "</P>" & _
"<img src=cid:orange.jpg 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, "
