Incrustar imagen en cuerpo de correo desde excel
Publicado por Andrés (3 intervenciones) el 27/07/2017 17:51:48
Hola estimados!
Les comento que esta es mi primera consulta al foro, sin embargo lo vengo siguiendo desde ya mucho tiempo...
Tengo una macro que me ayuda a enviar correos a distintos destinatarios con archivos adjuntos personalizados (por ejemplo un reporte "x" a la persona "x", y un reporte "y" a la persona "y"), además tengo una imagen incrustada en el correo pero es solo en la firma de éste. El problema que tengo es que necesito -en ocasiones- incrustar una imagen en el cuerpo del mensaje, la cual les llegará a todos, es decir no es una imagen personalizada.
Al intentar hacerlo, simplemente dupliqué el código el cual me inserta la imagen en la firma, en la sección del cuerpo del mensaje, pero se des configuró todo al enviar el correo.
Espero me puedan ayudar, este es mi código actual sin la línea de comando para incrustar la imagen en el cuerpo del mensaje (solo está la de la firma):
MUCHAS GRACIAS!
Les comento que esta es mi primera consulta al foro, sin embargo lo vengo siguiendo desde ya mucho tiempo...
Tengo una macro que me ayuda a enviar correos a distintos destinatarios con archivos adjuntos personalizados (por ejemplo un reporte "x" a la persona "x", y un reporte "y" a la persona "y"), además tengo una imagen incrustada en el correo pero es solo en la firma de éste. El problema que tengo es que necesito -en ocasiones- incrustar una imagen en el cuerpo del mensaje, la cual les llegará a todos, es decir no es una imagen personalizada.
Al intentar hacerlo, simplemente dupliqué el código el cual me inserta la imagen en la firma, en la sección del cuerpo del mensaje, pero se des configuró todo al enviar el correo.
Espero me puedan ayudar, este es mi código actual sin la línea de comando para incrustar la imagen en el cuerpo del mensaje (solo está la de la firma):
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Sub OutlookMailExcelAdjunto()
Dim OutApp As Object
Dim OutMail As Object
Dim para As Range
Dim asunto As Range
Dim cuerpo As Range
Dim archivo As Range
'Se crea la conexión con el gestor de correo
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.logon
'Se crea metodo de envio de correo
'Se definen el destinatario, la copia y la copia oculta, el asunto
'el cuerpo del correo y los archivos adjuntos si se requiere.Especificando
'los campos usados.
For i = 2 To Range("h28").Value
Set para = Range("b" & i)
Set asunto = Range("c" & i)
Set nombre = Range("d" & i)
Set cont = Range("h2")
Set cont2 = Range("h3")
Set cont3 = Range("h4")
Set cont4 = Range("h5")
Set cont5 = Range("h6")
Set cont6 = Range("h7")
Set cont7 = Range("h8")
Set cont8 = Range("h9")
Set cont9 = Range("h11")
Set firm = Range("h13")
Set firm2 = Range("h14")
Set firm3 = Range("h15")
Set firm4 = Range("h16")
Set firm5 = Range("h17")
Set firm6 = Range("h18")
Set firm7 = Range("h19")
Set archivo = Range("a" & i)
Set archivo1 = Range("h22")
Set archivo2 = Range("h23")
'On Error Resume Next
Set OutMail = OutApp.CreateItem(0)
'ActiveWorkbook.Save
With OutMail
.To = para.Value
' CC y CCO
If Range("f25").Value = True Then .CC = Range("h25").Value
If Range("f26").Value = True Then .BCC = Range("h26").Value
.Subject = asunto.Value
' cuerpo del mensaje y la firma
.Body = nombre.Value & vbCrLf & vbCrLf & cont.Value & vbCrLf & cont2.Value & vbCrLf & cont3.Value & vbCrLf & cont4.Value & vbCrLf & cont5.Value & vbCrLf & cont6.Value & vbCrLf & cont7.Value & vbCrLf & cont8.Value & vbCrLf & cont9.Value & vbCrLf & vbCrLf & firm.Value & vbCrLf & vbCrLf & firm2.Value & vbCrLf & firm3.Value & vbCrLf & firm4.Value & vbCrLf & firm5.Value & vbCrLf & firm6.Value & vbCrLf & firm7.Value
' imagen en la firma
.HTMLBody = .HTMLBody & "<img src='D:\Configuraciones y Documentos\arueda\Escritorio\BancoEstado\Banco\Herramientas\Planillas y calculadoras\logo.jpg'>"
' archivo adjunto personalizado
.Attachments.Add archivo.Value
'archivo adjunto en común
If Range("f22").Value = True Then .Attachments.Add archivo1.Value
If Range("f23").Value = True Then .Attachments.Add archivo2.Value
.SendEnd With
Next i
On Error GoTo 0
Set OutMail = NothingSet OutApp = NothingEnd Sub
MUCHAS GRACIAS!
Valora esta pregunta
0
