Word, Outlook y vb6 ...

Pues eso, que una vez desarrollada toda la aplicacion, me toca ponerla
"bonita"..., tengo un reporte que se dbe enviar por correo electronico y la
manera que he pensado es:

1.- tengo un formulario de Word, con sus campos a rellenar.
2.- lo abro con vb6, lo relleno con los registros del programa y lo guardo
como Html
3.- lo abro con outlook e intento embeberlo.

y el resultado deberia ser un email con mi formulario incrustado en él, pero
no... o no salen todas las imagenes o no incrusta nada... alguna idea?, o
alguna manera mejor de hacerlo?

un poco de codigo, a ver si veis algo raro!


'verificar que no este abierto el documento

Set MSWord = GetObject(, "Word.Application")
If Err <> 0 Then
Err.Clear
Set MSWord = CreateObject("Word.Application", "")
MSWord.Visible = True
Else
If MSWord.Visible = False And MSWord.Documents.Count > 0 Then
MSWord.Visible = True
End If
End If

Dim Doc As Object
Dim DocFound As Boolean, NumDoc As Integer
DocFound = False
For Each Doc In MSWord.Documents
DoEvents
If "F:\" & Doc.Name = "F:\Pentatrans Modelo.doc" Then
DocFound = True
Exit For
End If
Next Doc

NumDoc = MSWord.Documents.Count

If DocFound = False Then
'MSWord.Application.WindowState = wdWindowStateMaximize
MSWord.Documents.Open "F:\Pentatrans Modelo.doc", , True
Else
If MSWord.Application.WindowState = wdWindowStateMinimize Then
MSWord.Application.WindowState = wdWindowStateMaximize
End If
End If

Abro mi bdd y relleno:

If Rs.State = 1 Then
Rs.Close
End If

Tabla = "EXPE" & Anyobus
Sql = "SELECT * FROM " & Tabla & " WHERE NUMEXPE = " & Text1.Text
Rs.Source = Sql
Rs.Open , BCN, adOpenDynamic, adLockOptimistic

If Rs.EOF = True Then
MsgBox "Expedicion no existe"
On Error GoTo 0
Exit Sub
End If

MSWord.ActiveDocument.ActiveWindow.Document.FormFields("Numexpe").Result
= Text1.Text
.

MSWord.Activate
MSWord.ActiveDocument.SaveAs "C:\Formulario1.htm", wdFormatHTML

MSWord.Quit False
Set MSWord = Nothing

DoEvents

ahora nos metemos con el outlook

Dim objOutlook As Object
Dim objEMail As Object

Set objOutlook = GetObject(, "Outlook.Application")
If objOutlook Is Nothing Then Set objOutlook =
CreateObject("Outlook.Application")

Set objEMail = objOutlook.CreateItem(0)

With objEMail
.Subject = "Incidencia : " & Text1.Text
.Attachments.Add "c:\Formulario1.htm", olEmbeddeditem
.Display
End With

Set objEMail = Nothing
Set objOutlook = Nothing

On Error GoTo 0
Exit Sub