Agregar Tablas de excel a cuerpo de correo y adjuntar archivos distintos y anexar firma
Tengo la siguiente macro donde logro anexar la tabla al cuerpo del correo y los archivos adjuntos, pero lo que no logro es agregar la firma.
No se si tengo cosas de más, soy relativamente nuevo en esto y no me dedico a esto, yo busco codigos que hagan lo que quiero hacer, los analizo y los trato de adecuar a mis necesidades
Sub Botón3_Haga_clic_en()
Dim i, j As Integer
Dim pagina2 As Worksheet
Set pagina2 = ActiveWorkbook.Worksheets("CORREO")
Dim OutApp As Object
Dim Correo As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'Comprobar si Outlook esta abierto y en caso de no estarlo abrirlo
On Error Resume Next
Set OutApp = GetObject("", "Outlook.Application")
Err.Clear
If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
OutApp.Visible = True
Set Correo = OutApp.CreateItem(0)
'Contar el numero de archivos adjuntos
Dim numeroArchivos As Integer
numeroArchivos = 0
Do While pagina2.Cells(3 + numeroArchivos, 6) <> ""
numeroArchivos = numeroArchivos + 1
Loop
If MsgBox("¿Desea enviar el correo a ?" & Range("C5").Value, vbYesNo) = vbYes Then
'Seleccionamos el rango de celdas a enviar Select
ActiveSheet.Range("C10:D15").Select
'Mostramos la sección para enviar correo.
ActiveWorkbook.EnvelopeVisible = True
'Llamamos al envío...
With ActiveSheet.MailEnvelope
.Item.To = Range("C5").Value
.Item.CC = Range("C6").Value 'con copia a...
'.Item.bcc = "[email protected]" 'con copia oculta a...
.Item.Subject = Range("C7").Value
.Introduction = Range("C8").Value & vbCrLf
For i = 1 To numeroArchivos
.Item.Attachments.Add (pagina2.Cells(3 + i, 6).Value)
Next i
.Item.HTMLBody = Range("C15").Value
.Item.Send
End With
Call Botón2_Haga_clic_en
End If
End Sub
Respuesta de mike tamaniz
1
1 respuesta más de otro experto
Respuesta de Dante Amor
1

