Excel Envío Automático de e-mail con imagen
Excel Office 365
Buenas tardes grupo, tengo el siguiente código que envía un saludo de cumpleaños si la fecha de nacimiento cumple con la fecha de hoy. Esto se ejecuta cada vez que se abre el archivo. Aclarando que la celda de fecha de cumpleaños tiene el año 2019.
El problema es que en las pruebas en algunos mensajes no muestra la imagen y en otros si, a pesar de que se le da click en descargar imágenes y abriendo el correo desde un navegador... Menos.
¿Existe algo desde el código que pueda insertar para forzar el despliegue de la imagen?. U otra solución con al que me puedan ayudar.
Como siempre mil gracias
Jorgef...
Código:
Sub EnviarSaludo()
Dim OutlookApp As Outlook.Application
Dim objItem As MailItem
Dim UltimaFila As Long, x As Long
Dim FechaCumple As Date
Set OutlookApp = CreateObject("Outlook.Application")
Let UltimaFila = Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To UltimaFila
Let FechaCumple = Range("D" & x).Value
If FechaCumple = Date And Range("E" & x).Value = "" Then
Set objItem = OutlookApp.CreateItem(olMailItem)
With objItem
.To = Range("C" & x).Value
.Subject = Worksheets("E-Mail").Range("b1") & " " & Range("B" & x).Value
.Body = Worksheets("E-Mail").Range("b2")
.HTMLBody = .HTMLBody & "<img src='D:\Descargas\SaludoCumpleSerticol.jpg'>"
.Send
End With
Set objItem = Nothing
Range("E" & x).Value = "Enviado"
End If
Next x
Set OutlookApp = Nothing
MsgBox "Mensajes Enviados Exitosamente", vbInformation
End Sub
1 respuesta
Hola Abraham, gracias por tu ayuda, modifiqué el código pero aún no me funciona, al abrir outlook el recuadro de la imagen dice "no se puede mostrar la imagen vinculada". debe ser una simpleza.
te copio el código para ver si me puedes ayudar a revisar.
saludos y nuevamente mil gracias..
Jorgef.
Sub EnviarSaludo()
Dim OutlookApp As Outlook.Application
Dim objItem As MailItem
Dim UltimaFila As Long, x As Long
Dim FechaCumple As Date
Set OutlookApp = CreateObject("Outlook.Application")
Let UltimaFila = Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To UltimaFila
Let FechaCumple = Range("D" & x).Value
If FechaCumple = Date And Range("E" & x).Value = "" Then
Set objItem = OutlookApp.CreateItem(olMailItem)
With objItem
.To = Range("C" & x).Value
.Subject = Worksheets("E-Mail").Range("b1") & " " & Range("B" & x).Value
.Attachments.Add "D:\Descargas\SaludoCumpleSerticol.jpg"
'.Body = Worksheets("E-Mail").Range("b2")
'.HTMLBody = .HTMLBody & "<img src= .Attachments.item(1).filename & height=100 width=75>"
.HTMLBody = "<html>" & _
"<body>" & _
"<p>Buen Día</p>" & _
"<br>" & _
"<br>" & _
"<img src='cid:'" & .Attachments.Item(1).Filename & "'' height=100 width=75>" & _
"</body>" & _
"</html>"
.Send
End With
Set objItem = Nothing
Range("E" & x).Value = "Enviado"
End If
Next x
Set OutlookApp = Nothing
MsgBox "Mensajes Enviados Exitosamente", vbInformation
End Sub
Dado que en el otro foro fue bien respondida, sugiero cerrar este mensaje. Saludos]
Abraham Valencia
