Картинка из Excel в Outlook - VB

Формулировка задачи:

Уважаемы, доброго времени суток! Пробую написать макрос, который через Excel, отправляет электронное сообщение через Outlook. В качестве подписи используется

картинка

. После долгих поисков и методов описанных на разных форумах понял, что лучший вариант, это использовать в теле письма

htmlBody

тэги. В итоге, вроде и текст пишется и картинка вставляется. Но есть одна проблема, если письмо отправлять используя методо

DISPLAY

, то все хорошо (отправляется и текст и картинка), если использовать

SEND

, то уходит только текст, а самой картинки нет. Пробовал ставить пере отправкой письма и после очистки сообщения

таймаут

на отправку, думая, что возможно при отправке не успевает подгрузиться картинка. Если отправить 2 письма,то можно и через DISPLAY, а если это 1000 писем!!.Вот код:

                    Листинг программы
                
 
                            
                        
Sub SendMail()
 
Dim OutApp As Object
Dim OutMail As Object
Dim htmlBody As String
 
picfile$ = "C:\Users\image002.gif"
 
    htmlBody = "<body><font face=Arial color=#000080 size=2></font>" & _
                "<br>" & "1. Г§Г«Г*ГІГ*" & "<br>" & "<br><br><img width=290 height=150 alt='' hspace=0 src='" & picfile$ & " ' align=baseline order=0>&nbsp;</body>"
            
        Application.ScreenUpdating = False
        Set OutApp = CreateObject("Outlook.Application")   'Г§Г*ГЇГіГ±ГЄГ*ГҐГ¬ Outlook Гў Г±ГЄГ°Г»ГІГ®Г¬ Г°ГҐГ¦ГЁГ¬ГҐ
            OutApp.Session.Logon ("removed@mail.ru")
        On Error GoTo cleanup 'ГҐГ±Г«ГЁ Г*ГҐ Г§Г*ГЇГіГ±ГІГЁГ«Г±Гї - ГўГ»ГµГ®Г¤ГЁГ¬
                
        Set OutMail = OutApp.CreateItem(0)   'Г±Г®Г§Г¤Г*ГҐГ¬ Г*Г®ГўГ®ГҐ Г±Г®Г®ГЎГ№ГҐГ*ГЁГҐ
        On Error Resume Next    'Г§Г*ГЇГ®Г«Г*ГїГҐГ¬ ГЇГ®Г«Гї Г±Г®Г®ГЎГ№ГҐГ*ГЁГї
                 
        With OutMail
            .To = E_mail 'Count
            .Subject = "ГІГҐГ±ГІ"
            .BodyFormat = 2
            .htmlBody = htmlBody
            .Send
        End With
 
        On Error GoTo 0
                
        Application.Wait (Now + TimeValue("0:00:01")) 'Г*Г* 1 Г±ГҐГЄ
        Set OutMail = Nothing
cleanup:
        Set OutApp = Nothing
        Application.ScreenUpdating = True
End Sub

Решение задачи: «Картинка из Excel в Outlook»

textual
                            Листинг программы 
                        
 
                        
                          
                    
dim cdoMessage, cdoConfig, sch
 
sch = "http://schemas.microsoft.com/cdo/configuration/"
Set cdoConfig = Server.CreateObject("CDO.Configuration")
set cdoMessage = Server.CreateObject("CDO.Message")
 
With cdoConfig.Fields
  .Item(sch & "sendusing") = 2 ' cdoSendUsingPort
  .Item(sch & "smtpserver") = "<your SMTP server>"
  .Item(sch & "sendusername") = "<SMTP username>"
  .Item(sch & "sendpassword") = "<SMTP password>"
  .update
End With
 
Set cdoMessage.Configuration = cdoConfig
cdoMessage.From = "test@test.com"
cdoMessage.ReplyTo = "test@test.com"
cdoMessage.To = "<your test email address>"
cdoMessage.Subject = "Test subject"
cdoMessage.HtmlBody = "<html><body><img src=""cid:myimage.gif""/></body></html>" & vbCrLf
 
Set objBP = cdoMessage.AddRelatedBodyPart("c:\head-logo.gif", "myimage.gif", CdoReferenceTypeName)
objBP.Fields.Item("urn:schemas:mailheader:Content-ID") = "<myimage.gif>"
objBP.Fields.Update
 
cdoMessage.Send