Configurando una imagen de fondo usando HTML en un Outlook 2010 usando Excel VBA
Estoy tratando de utilizar Excel VBA para crear un correo electrónico con respecto a la compañía de seguros una imagen de fondo (Bienvenida.jpg) con. A continuación, desea tener texto o un cuadro de texto idealmente sobre él con el texto en negrita de color amarillo que puedo llenar en tiempo de ejecución.
Puedo añadir una imagen al correo electrónico (la parte HTML comentado hace eso), pero me parece que no puede obtener una imagen de fondo para cargar en. Estoy modificando el código que encontré en línea en algún lugar, pero mis conocimientos de HTML no son bastante buenos.
Estoy seguro de que esta parte es mi problema:
.Attachments.Add "C:\Users\Eulen Steven\Downloads\image001.jpg", olByValue, 0
.HTMLBody = .HTMLBody & "<html><center><img src='.\image001.jpg'></center></html>"
Aquí esta el código completo:
Sub macro()
Application.ScreenUpdating = Falso
Dim outlookOBJ As Object
Dim mitem As Object
Dim ruta_archivo As String
Dim adjunto2 As String
Dim adjunto3 As String
Dim nume_regi As Long
Dim i As Long
Dim enviara As String
Dim asunto As String
Dim empresa As String
Dim persona As String
Dim sinenviar As Integer
Dim Fecha As String
Dim SACC As String
Dim MyText As String
Dim MyHTML As String
Dim wdApp As Object, wdDoc As Object
sinenviar = 0
Sheets("Macro").Activate
Range("E700").Select
Range(Selection, Selection.End(xlDown)).Select
nume_regi = Selection.Count
For i = 1 To nume_regi
On Error Resume Next
ruta_archivo = Cells(9 + i, 9).Value
If ruta_archivo <> "" Then
Dim partes() As String
partes = Split(ruta_archivo, ".")
If partes(UBound(partes)) = "docx" Then
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then 'Word isn't already running
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wdDoc = wdApp.Documents.Open(ruta_archivo)
wdDoc.Activate
wdApp.ActiveDocument.ExportAsFixedFormat _
OutputFileName:=Replace(ruta_archivo, "docx", "pdf"), _
ExportFormat:=17, _
OpenAfterExport:=False, _
OptimizeFor:=0, _
Range:=0, _
From:=1, _
To:=1, _
Item:=0, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=0, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False
wdApp.ActiveDocument.Close SaveChanges:=False
wdApp.Quit
Set wdApp = Nothing
Cells(9 + i, 9).Value = Replace(ruta_archivo, "docx", "pdf")
End If
End If
Next i
Dim cantidad As Integer
cantidad = 0
For i = 1 To nume_regi
persona = Cells(9 + i, 5)
adjunto2 = ""
If persona <> "" Then
Set outlookOBJ = CreateObject("Outlook.Application")
poliza = Cells(9 + i, 6)
SACC = Cells(9 + i, 7)
Fecha = Cells(9 + i, 8)
asunto = "Bienvenido a MetLife Colombia Seguros de Vida S.A. Póliza de Accidentes Personales N° " & poliza
'cuerpo = UCase(persona) & "</b>"
ruta_archivo = Cells(9 + i, 9).Value
adjunto2 = Cells(9 + i, 10).Value
adjunto3 = Cells(9 + i, 12).Value
enviara = Cells(9 + i, 11)
With mitem
.Importance = 2 'Importancia alta
.To = enviara
.Subject = asunto
MyText = "Sr(a)" & persona
.Attachments.Add "C:\Users\Eulen Steven\Downloads\image001.jpg", olByValue, 0
.HTMLBody = .HTMLBody & "<html><center><img src='.\image001.jpg'></center></html>"
.Attachments.Add Item
End With
If ruta_archivo <> " " Then
With mitem
.Attachments.Add (ruta_archivo)
End With
If LTrim(adjunto2) <> "" Then
With mitem
.Attachments.Add (adjunto2)
End With
End If
If LTrim(adjunto3) <> "" Then
With mitem
.Attachments.Add (adjunto3)
End With
End If
Else
sinenviar = 1 + sinenviar
End If
With mitem
'.send
.Display
End With
cantidad = cantidad + 1
End If
Next i
Range("E5").Select
Application.ScreenUpdating = True
Set outlookOBJ = Nothing
Set mitem = Nothing
MsgBox ("Finalizado se enviaron " & cantidad - sinenviar & " de los " & cantidad & " Correos con éxito ")
Exit Sub
End Sub
