Enviar mail con imagen Excel VBA
Tengo un código que funciona genial para enviar mail:
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objItem = objOutlook.CreateItem(olMailItem)
objNamespace.Logon "EXCELSPACE", , True, True
Dim LaRuta As String
nombre1 = "imagen.jpg"
LaRuta = ActiveWorkbook.Path
adjunto = LaRuta & "\" & nombre1
With objItem
.Attachments.Add (adjunto)
.Display
.To = ""
.CC = ""
.BCC = ""
.Subject = "Sujeto."
.body = "texto a enviar. "
End With
objNamespace.Logoff
Set objOutlook = Nothing
Set objItem = Nothing
Set objNamespace = Nothing
Lo que estoy intentando hacer es que en vez de enviar una imagen adjuntada, quiero que envíe la imagen como parte del cuerpo del mensaje.
2 Respuestas
Paso la respuesta ya que a alguna persona le puede servir:
Dim OutApp As Object
Dim OutMail As Object
Dim ultFil As Long
Dim i As Long
'Ultima fila usada
ultFil = Range("A:A").Find("*", , , , , xlPrevious).Row
'Outlook
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon'IMPORTANTE: Bucle para enviar emails, si solamente es un mail solo, poner como valor de la variable "ultFil" 2
For i = 2 To ultFil
If Cells(i, "A") <> Empty Then'Crea el correo
Set OutMail = OutApp.CreateItem(0)
With OutMail
'manejo de cuentas
.SentOnBehalfOfName = "[email protected]"
'Destinatario
.To = Range("B2").Value'Asunto
.Subject = "Aqui va el nombre del asunto"'Archivo adjunto (opcional)
'nombre1 = "dooos.jpg"
'LaRuta = ActiveWorkbook.Path
'adjunto = LaRuta & "\" & nombre1
'.Attachments.Add adjunto.BodyFormat = 2 'olFormatHTML
.HTMLBody = "<html>" & _
"<body>" & _
"<p>Aqui va el mensaje que deseas enviar...</p>" & _
"<br>" & _
"<br>" & _
"<br>" & _
"<img src=http://www.enlacequeyoquiero.com.ar/Encabezado.jpg' width=800 height=133>" & _
"</body>" & _
"</html>"
.Display
End With
End If
Next i
Set OutMail = Nothing
Set OutApp = Nothing
H o l a:
Para enviar la imagen en el cuerpo del correo, una opción es con HTML:
Sub env()
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objItem = objOutlook.CreateItem(olMailItem)
objNamespace.Logon "EXCELSPACE", , True, True
Dim LaRuta As String
nombre1 = "imagen.jpg"
LaRuta = ActiveWorkbook.Path
adjunto = LaRuta & "\" & nombre1
With objItem
.To = ""
.CC = ""
.BCC = ""
.Subject = "Sujeto."
.Attachments.Add (adjunto)
'Act.Por.Dante Amor
.HTMLBody = _
"<HTML> " & _
"<BODY>" & _
"<P>" & "Texto a enviar" & _
"</P>" & _
"<img src=cid:>" & _
"</BODY> " & _
"</HTML>"
'Act.Por.Dante Amor
.Display
End With
objNamespace.Logoff
Set objOutlook = Nothing
Set objItem = Nothing
Set objNamespace = Nothing
End Sub':) 'S aludos. D a n t e A m o r . R ecuerda valorar la respuesta. G racias ':)
Buen día Dante, muchas gracias. Justamente encontré la solución y parece que respondimos juntos. Muchas gracias por tu tiempo.
Saludos!
Igualmente buen día, bueno, ahora ya hay 2 soluciones para los interesados. S aludos!