Access - No puedo adjuntar imagen a email desde access

Hola
Me gustaría que alguien me echara una mano en este asunto que me trae de cabeza.
Resulta que he conseguido en algun foro el código de referencia y despues de adaptarlo he conseguido enviarlo desde acces. Ahora bien, no consigo enviar la imagen como imagen de fondo o firma al igual que en el codigo html no consigo poner un campo calculado (sHTML = sHTML & NombreArchivoPDF ).
Alguien puede ayudarme?
Muchas gracias


Private Sub Comando80_Click()

' ************************************ENVIO DE EMAIL **************************************************

'Definimos dos constantes, donde introduciremos la cuenta de correo, el password y el smtp

Const miMail As String = "******@*******.com"
Const miPass As String = "********"
Const miSmtp As String = "***************"

'Definimos las variables
Dim elAsunto As String, elMsg As String
Dim mailA As String, mailCC As String, mailCCO As String, BodyPart As String
Dim HTMLBody
Dim sHTML

'Inicializamos las variables
elAsunto = NombreArchivoPDF
elMsg = "Hola, adjunto te remito " & NombreArchivoPDF
mailA = Nz(Me.email.Value, "")
'mailCC = Nz(Me.cboCC.Value, "")
'mailCCO = Nz(Me.cboCCO.Value, "")
HTMLBody = sHTML

'Si no hay destinatario avisamos y salimos del proceso
If mailA = "" Then
MsgBox "¡Debe existir un destinatario!", vbCritical, "SIN DESTINATARIO"
Exit Sub
End If

'Configuramos el bloque CDO
Dim cdoConfig
Dim msgOne
Set cdoConfig = CreateObject("CDO.Configuration")
With cdoConfig.Fields

'creamos el cuerpo de la plantilla adjunta
sHTML = sHTML & "<img src =C:\imagenes\zebras.gif"
sHTML = sHTML & " <P> "
sHTML = sHTML & " <P> "
sHTML = sHTML & " <P> PRUEBA 1"
sHTML = sHTML & " <P> PRUEBA 2"
sHTML = sHTML & " <P> PRUEBA 3"
sHTML = sHTML & " <P> PRUEBA 4"
sHTML = sHTML & NombreArchivoPDF

.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = miSmtp
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = miMail
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = miPass
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Update
End With

'Configuramos el mensaje

Set msgOne = CreateObject("CDO.Message")
Set msgOne.Configuration = cdoConfig
With msgOne
.To = mailA
.CC = mailCC
.BCC = mailCCO
.From = miMail
.subject = elAsunto
.TextBody = elMsg
.HTMLBody = sHTML

.AutoGenerateTextBody = False
.AddRelatedBodyPart "C:/imagenes/zebras.gif", "zebras.gif", cdoRefTypeLocation

End With

'Configuramos el adjunto

Dim miAdjunto As String
miAdjunto = RutaPDF
msgOne.AddAttachment (miAdjunto)
msgOne.Send

'Avisamos de que el envío ha ido bien

MsgBox "Mensaje enviado con éxito", vbInformation, "CORRECTO"
MsgBox "se ha enviado a: " & mailA & " " & [miAdjunto], vbInformation, "CORRECTO"
Salida:
Exit Sub
sol_err:
MsgBox Err.Number & ": " & Err.Description
Resume Salida

End Sub