MyTetra Share
Делитесь знаниями!
Как отправить письмо из Excel?
16.03.2019
23:43
Текстовые метки: vba, outlook,sent
Раздел: !Закладки - VBA - Outlook

Как отправить письмо из Excel?

 

Прежде чем начать читать статью прошу принять к сведению объявление: используйте СВОИ АДРЕСА ЭЛ.ПОЧТЫ при тестировании кодов. Не надо отсылать письма на указанные в статье e-mail адреса- это все приходит мне на почту. Помимо этого Вы сами не сможете понять работает или нет, т.к. письма придут мне, а не Вам.
Спасибо за понимание
P.S. А если написанное выше Вы все же проигнорировали и отправили письмо на мои адреса электронной почты - это означает, что Вы соглашаетесь с тем, что вся информация внутри письма, включая вложения, может быть использована мной без ограничений в личных целях.

Отправить письмо из Excel можно несколькими способами, в том числе и через написание кода в VBA.


Отправка через меню Excel
Отправку без кода осуществить достаточно просто:

  • Excel 2003: Файл(File) -Отправить(Send To) -Сообщение(Mail Recipient)
    и выбрать способ отправки:
    • Сообщение(Mail Recipient) - создается сообщение в программе по умолчанию для отправки электронных писем
    • Сообщение (для ознакомления) (Mail Recipient for Review) - вполне интересный вариант. Перед отправкой для книги включается отслеживание изменений(Сервис(Tools)-Исправления(Track changes)). Можно воспользоваться этим методом, чтобы отправить получателю для внесения им изменений, а после отследить их(Сервис -Исправления -Выделить исправления(Highlight changes))
    • Сообщение (как вложение)(Mail Recipient as attachment) - создается сообщение в программе по умолчанию для отправки электронных писем, в которое вложением вкладывается активная книга целиком
    • По маршруту(Routing Recipient) - практически тоже самое, что и Сообщение (для ознакомления) (Mail Recipient for Review) с той разницей, что письмо с вложением пересылается как эстафета от одного получателя к другому. После этого так же можно отследить изменения, внесенные каждым пользователем
    • Папка Exchange(Exchange folder) - активная книга автоматически сохраняется в заданную папку общего сервера Microsoft Exchange. Доступ к этой книге будет открыт всем участникам рабочей группы
    • Факс пользователю службы факсов интернета(Fax) - отправляет содержимое книги по факсу указанным получателям. Для использования данной возможности должна быть установлена служба факсов

     

  • Excel 2007: Кнопка Офис -Отправить(Send) -Сообщение(E-mail)
  • Excel 2010: Файл(File) -Сохранить и отправить(Save & Send) -Отправить(Send Using E-mail)

Далее выбирается способ отправки:

  • Как вложение(Send as attachment) - будет автоматически запущена почтовая программа по умолчанию и создано новое письмо, в которое уже будет вложен файл книги, из которой была вызвана команда
  • Как ссылку(Send link) - доступно, только если файл находится на сетевом ресурсе. После нажатия будет создано новое письмо в почтовой программе по умолчанию, в тело которого будет вставлена ссылка на книгу
  • Как PDF(Send as PDF) - файл будет автоматически сохранен в формате PDF, далее будет создано новое письмо в почтовой программе по умолчанию и файл PDF будет вставлен в письмо
  • Как XPS(Send as XPS) - файл будет автоматически сохранен в формате PDF, далее будет создано новое письмо в почтовой программе по умолчанию и файл PDF будет вставлен в письмо
  • Отправить как факс через интернет(Send as internet fax) - если у вас на ПК установлена служба работы с факсами и есть возможность отправлять и получать факсы на ПК - то данная команда отправит данные активного листа файла как факс

Sub SendMailStandart() ActiveWorkbook.SendMail "mail1@excel-vba.ru", "Тема письма" End Sub


1

2

3

Sub SendMailStandart()

    ActiveWorkbook.SendMail "mail1@excel-vba.ru", "Тема письма"

End Sub


Также можно указать несколько получателей:

Sub SendMailStandart_MassRecipients() ActiveWorkbook.SendMail Array("mail1@excel-vba.ru", "mail2@excel-vba.ru"), "Тема письма" End Sub


1

2

3

Sub SendMailStandart_MassRecipients()

    ActiveWorkbook.SendMail Array("mail1@excel-vba.ru", "mail2@excel-vba.ru"), "Тема письма"

End Sub


Внутри скобок Array можно в кавычках через запятую указать достаточное количество получателей.
Данный метод универсален, но работает только с активным файлом. Нельзя выбрать файл с диска и отправить как вложение. Кроме того, нельзя отправить более одного файла разом и указать текст письма.
Поэтому очень часто на форумах возникает вопрос
как отправить письмо из Excel кодом с указанием темы, текста и вложения.
Есть несколько вариантов:



Option Explicit Sub Send_Mail() Dim objOutlookApp As Object, objMail As Object Dim sTo As String, sSubject As String, sBody As String, sAttachment As String Application.ScreenUpdating = False On Error Resume Next 'пробуем подключиться к Outlook, если он уже открыт Set objOutlookApp = GetObject(, "Outlook.Application") Err.Clear 'Outlook закрыт, очищаем ошибку If objOutlookApp Is Nothing Then Set objOutlookApp = CreateObject("Outlook.Application") End If objOutlookApp.Session.Logon Set objMail = objOutlookApp.CreateItem(0) 'создаем новое сообщение 'если не получилось создать приложение или экземпляр сообщения - выходим If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub sTo = "AddressTo@mail.ru" 'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value) sSubject = "Автоотправка" 'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value) sBody = "Привет от Excel-VBA" 'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value) sAttachment = "C:\Temp\Книга1.xls" 'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value) 'создаем сообщение With objMail .To = sTo 'адрес получателя .CC = "" 'адрес для копии .BCC = "" 'адрес для скрытой копии .Subject = sSubject 'тема сообщения .Body = sBody 'текст сообщения '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.) .Attachments.Add sAttachment 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра End With Set objOutlookApp = Nothing: Set objMail = Nothing Application.ScreenUpdating = True End Sub


1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

Option Explicit

 

Sub Send_Mail()

    Dim objOutlookApp As Object, objMail As Object

    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String

 

    Application.ScreenUpdating = False

    On Error Resume Next

    'пробуем подключиться к Outlook, если он уже открыт

    Set objOutlookApp = GetObject(, "Outlook.Application")

    Err.Clear 'Outlook закрыт, очищаем ошибку

    If objOutlookApp Is Nothing Then

        Set objOutlookApp = CreateObject("Outlook.Application")

    End If

    objOutlookApp.Session.Logon

    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение

    'если не получилось создать приложение или экземпляр сообщения - выходим

    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub

    

    sTo = "AddressTo@mail.ru"    'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)

    sSubject = "Автоотправка"    'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)

    sBody = "Привет от Excel-VBA"    'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)

    sAttachment = "C:\Temp\Книга1.xls"    'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value)

    

    'создаем сообщение

    With objMail

        .To = sTo 'адрес получателя

        .CC = "" 'адрес для копии

        .BCC = "" 'адрес для скрытой копии

        .Subject = sSubject 'тема сообщения

        .Body = sBody 'текст сообщения

        '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.)

        .Attachments.Add sAttachment 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName

        .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра

    End With

 

    Set objOutlookApp = Nothing: Set objMail = Nothing

    Application.ScreenUpdating = True

End Sub


Этот код отправляет одно письмо и одно вложение за раз. Но если несколько раз вызвать метод .Attachments.Add, то можно добавить еще файлы:

.Attachments.Add "C:\Temp\Книга1.xlsx" .Attachments.Add "C:\Temp\Книга2.xlsx" .Attachments.Add "C:\Documents\Report.rar"


1

2

3

.Attachments.Add "C:\Temp\Книга1.xlsx"

.Attachments.Add "C:\Temp\Книга2.xlsx"

.Attachments.Add "C:\Documents\Report.rar"

Важно помнить: пути для файлов в качестве вложений должны содержать полный путь до файла, включая его имя и расширение: C:\Documents\Report.rar. При указании только имени Report.rar или пути без расширения (C:\Documents\Report) ошибки не будет, но вложения не будут помещены в сообщения и адресату отправится письмо без вложений.

Этот код создает сообщение, но есть маленький нюанс - если в Outlook настроено добавление подписей в новые сообщения - то созданные кодом VBA письма игнорирует эту настройку(особенность Outlook, так назовем). Поэтому, если необходимо отправлять письма с подписью, то ознакомьтесь со статьей: Вставить в письмо подпись из Outlook через VBA
В этой же статье можно посмотреть пример составления письма с форматированным текстом.


Sub Send_Mail_Mass() Dim objOutlookApp As Object, objMail As Object Dim sTo As String, sSubject As String, sBody As String, sAttachment As String Dim lr As Long, lLastR As Long Application.ScreenUpdating = False On Error Resume Next 'пробуем подключиться к Outlook, если он уже открыт Set objOutlookApp = GetObject(, "Outlook.Application") Err.Clear 'Outlook закрыт, очищаем ошибку If objOutlookApp Is Nothing Then Set objOutlookApp = CreateObject("Outlook.Application") End If 'произошла ошибка создания объекта - выход If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub objOutlookApp.Session.Logon lLastR = Cells(Rows.Count, 1).End(xlUp).Row 'цикл от второй строки(начало данных с адресами) до последней ячейки таблицы For lr = 2 To lLastR Set objMail = objOutlookApp.CreateItem(0) 'создаем новое сообщение 'создаем сообщение With objMail .to = Cells(lr, 1).Value 'адрес получателя .Subject = Cells(lr, 2).Value 'тема сообщения .Body = Cells(lr, 3).Value 'текст сообщения .Attachments.Add Cells(lr, 4).Value .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра End With Next lr Set objOutlookApp = Nothing: Set objMail = Nothing Application.ScreenUpdating = True End Sub


1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

Sub Send_Mail_Mass()

    Dim objOutlookApp As Object, objMail As Object

    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String

    Dim lr As Long, lLastR As Long

 

    Application.ScreenUpdating = False

    On Error Resume Next

    'пробуем подключиться к Outlook, если он уже открыт

    Set objOutlookApp = GetObject(, "Outlook.Application")

    Err.Clear 'Outlook закрыт, очищаем ошибку

    If objOutlookApp Is Nothing Then

        Set objOutlookApp = CreateObject("Outlook.Application")

    End If

    'произошла ошибка создания объекта - выход

    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub

    objOutlookApp.Session.Logon

 

    lLastR = Cells(Rows.Count, 1).End(xlUp).Row

    'цикл от второй строки(начало данных с адресами) до последней ячейки таблицы

    For lr = 2 To lLastR

        Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение

        'создаем сообщение

        With objMail

            .to = Cells(lr, 1).Value 'адрес получателя

            .Subject = Cells(lr, 2).Value 'тема сообщения

            .Body = Cells(lr, 3).Value 'текст сообщения

            .Attachments.Add Cells(lr, 4).Value

            .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра

        End With

    Next lr

 

    Set objOutlookApp = Nothing: Set objMail = Nothing

    Application.ScreenUpdating = True

End Sub


Скачать пример массовой рассылки:

  Tips_Macro_SendMail_Mass.xls (53,5 KiB, 2 534 скачиваний)

При использовании этих кодов есть один недостаток: очень часто при программной отправке писем Outlook выдает окно с запросом подтверждения отправки. Сообщение может быть трех видов:

  • Программа пытается получить доступ к адресам электронной почты, хранящимся в Outlook. Если вы этого не ожидаете, нажмите кнопку "Запретить" и проверьте наличие последних обновлений для антивирусной программы.
  • Программа пытается отправить сообщение от вашего имени. Если вы этого не ожидаете, нажмите кнопку "Запретить" и проверьте наличие последних обновлений для антивирусной программы.
  • Программа пытается выполнить действие, которое может привести к отправке сообщения от вашего имени. Если вы этого не ожидаете, нажмите кнопку "Запретить" и проверьте наличие последних обновлений для антивирусной программы

Чтобы при программной отправке данных сообщений не появлялось, в версиях Outlook, начиная с 2007 можно отключить его настройками безопасности:

  • Outlook 2007: Меню-Параметры-Центр управления безопасностью-Программный доступ-установить Никогда не предупреждать о подозрительной активности (не рекомендуется)
  • Outlook 2010 и выше: Файл-Параметры-Центр управления безопасностью-Программный доступ-установить Никогда не предупреждать о подозрительной активности (не рекомендуется)

ВАЖНО: Если компьютер управляется администратором Microsoft Exchange или Microsoft Windows Active Directory Domain Services и администратором в качестве параметров по умолчанию установлен запрет на внесение изменений в параметры безопасности пользователями, возможность изменения данных настроек безопасности программного доступа будет недоступна.

Важно: сам код рассылки не имеет никаких ограничений по числу отправляемых сообщений. Но различные почтовые серверы могут устанавливать свои лимиты. Например, Gmail и Yandex могут заблокировать email, с которого ведется рассылка, если общее количество отправленных сообщений превышает 100 штук в день. Поэтому производить важные массовые рассылки рекомендуется с собственного SMTP-сервера.


Отправка сообщения без использования Outlook - используем CDO

Option Explicit Sub Send_Mail() Const CDO_Cnf = "http://schemas.microsoft.com/cdo/configuration/" Dim oCDOCnf As Object, oCDOMsg As Object Dim SMTPserver As String, sUsername As String, sPass As String, sMsg As String Dim sTo As String, sFrom As String, sSubject As String, sBody As String, sAttachment As String On Error Resume Next 'sFrom – как правило совпадает с sUsername SMTPserver = "smtp.yandex.ru" ' SMTPServer: для Mail.ru "smtp.mail.ru"; для Яндекса "smtp.yandex.ru"; для Рамблера "mail.rambler.ru" sUsername = "YourMail@mail.ru" ' Учетная запись на сервере sPass = "1234" ' Пароль к почтовому аккаунту If Len(SMTPserver) = 0 Then MsgBox "Не указан SMTP сервер", vbInformation, "www.Excel-VBA.ru": Exit Sub If Len(sUsername) = 0 Then MsgBox "Не указана учетная запись", vbInformation, "www.Excel-VBA.ru": Exit Sub If Len(sPass) = 0 Then MsgBox "Не указан пароль", vbInformation, "www.Excel-VBA.ru": Exit Sub sTo = "AddressTo@mail.ru" 'Кому sFrom = "YourMail@yandex.ru" 'От кого sSubject = "Автоотправка" 'Тема письма sBody = "Привет от Excel-VBA" 'Текст письма sAttachment = "C:/Temp/Книга1.xls" 'Вложение(полный путь к файлу) 'Проверка наличия файла по указанному пути If Dir(sAttachment, vbDirectory) = "" Then sAttachment = "" 'Назначаем конфигурацию CDO Set oCDOCnf = CreateObject("CDO.Configuration") With oCDOCnf.Fields .Item(CDO_Cnf & "sendusing") = 2 .Item(CDO_Cnf & "smtpauthenticate") = 1 .Item(CDO_Cnf & "smtpserver") = SMTPserver 'если необходимо указать SSL '.Item(CDO_Cnf & "smtpserverport") = 465 'для Яндекса и Gmail 465 '.Item(CDO_Cnf & "smtpusessl") = True '===================================== .Item(CDO_Cnf & "sendusername") = sUsername .Item(CDO_Cnf & "sendpassword") = sPass .Update End With 'Создаем сообщение Set oCDOMsg = CreateObject("CDO.Message") With oCDOMsg Set .Configuration = oCDOCnf .BodyPart.Charset = "koi8-r" .From = sFrom .To = sTo .Subject = sSubject .TextBody = sBody If Len(sAttachment) > 0 Then .AddAttachment sAttachment .Send End With Select Case Err.Number    Case -2147220973: sMsg = "Нет доступа к Интернет"    Case -2147220975: sMsg = "Отказ сервера SMTP"    Case 0: sMsg = "Письмо отправлено"    Case Else: sMsg = "Ошибка номер: " & Err.Number & vbNewline & "Описание ошибки: " & Err.Description    End Select MsgBox sMsg, vbInformation, "www.Excel-VBA.ru" Set oCDOMsg = Nothing: Set oCDOCnf = Nothing End Sub


1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

Option Explicit

 

Sub Send_Mail()

    Const CDO_Cnf = "http://schemas.microsoft.com/cdo/configuration/"

    Dim oCDOCnf As Object, oCDOMsg As Object

    Dim SMTPserver As String, sUsername As String, sPass As String, sMsg As String

    Dim sTo As String, sFrom As String, sSubject As String, sBody As String, sAttachment As String

    On Error Resume Next

    'sFrom – как правило совпадает с sUsername

    SMTPserver = "smtp.yandex.ru"    ' SMTPServer: для Mail.ru "smtp.mail.ru"; для Яндекса "smtp.yandex.ru"; для Рамблера "mail.rambler.ru"

    sUsername = "YourMail@mail.ru"    ' Учетная запись на сервере

    sPass = "1234"    ' Пароль к почтовому аккаунту

 

    If Len(SMTPserver) = 0 Then MsgBox "Не указан SMTP сервер", vbInformation, "www.Excel-VBA.ru": Exit Sub

    If Len(sUsername) = 0 Then MsgBox "Не указана учетная запись", vbInformation, "www.Excel-VBA.ru": Exit Sub

    If Len(sPass) = 0 Then MsgBox "Не указан пароль", vbInformation, "www.Excel-VBA.ru": Exit Sub

 

    sTo = "AddressTo@mail.ru"    'Кому

    sFrom = "YourMail@yandex.ru"    'От кого

    sSubject = "Автоотправка"    'Тема письма

    sBody = "Привет от Excel-VBA"    'Текст письма

    sAttachment = "C:/Temp/Книга1.xls"    'Вложение(полный путь к файлу)

    'Проверка наличия файла по указанному пути

    If Dir(sAttachment, vbDirectory) = "" Then sAttachment = ""

    'Назначаем конфигурацию CDO

    Set oCDOCnf = CreateObject("CDO.Configuration")

    With oCDOCnf.Fields

        .Item(CDO_Cnf & "sendusing") = 2

        .Item(CDO_Cnf & "smtpauthenticate") = 1

        .Item(CDO_Cnf & "smtpserver") = SMTPserver

        'если необходимо указать SSL

        '.Item(CDO_Cnf & "smtpserverport") = 465 'для Яндекса и Gmail 465

        '.Item(CDO_Cnf & "smtpusessl") = True

        '=====================================

        .Item(CDO_Cnf & "sendusername") = sUsername

        .Item(CDO_Cnf & "sendpassword") = sPass

        .Update

    End With

    'Создаем сообщение

    Set oCDOMsg = CreateObject("CDO.Message")

    With oCDOMsg

        Set .Configuration = oCDOCnf

        .BodyPart.Charset = "koi8-r"

        .From = sFrom

        .To = sTo

        .Subject = sSubject

        .TextBody = sBody

        If Len(sAttachment) > 0 Then .AddAttachment sAttachment

        .Send

    End With

 

    Select Case Err.Number

   Case -2147220973: sMsg = "Нет доступа к Интернет"

   Case -2147220975: sMsg = "Отказ сервера SMTP"

   Case 0: sMsg = "Письмо отправлено"

   Case Else: sMsg = "Ошибка номер: " & Err.Number & vbNewline & "Описание ошибки: " & Err.Description

   End Select

    MsgBox sMsg, vbInformation, "www.Excel-VBA.ru"

    Set oCDOMsg = Nothing: Set oCDOCnf = Nothing

End Sub

Данный код отправляет письмо, используя объект CDO(Collaboration Data Objects - присутствует во всех версиях Windows) и от имени Вашей учетной записи(либо Яндекс, либо Мэйл, либо Рамблер либо др.).

  • SMTPserver - Каждый из приведенных выше сервисов имеет свой сервер для отправки сообщений(его можно посмотреть на сайте сервиса). В комментариях к коду я написал три самых распространенных, но если Вы используете какой-то другой, то просто посмотрите на его сайте настройки для Outlook и отыщите тот параметр, который отвечает за SMTPserver.
  • sUsername - это Ваш логин для входа в почтовый сервис. Думаю тут все понятно. Единственный момент - обязательно указывать e-mail именно в полном виде - YourMail@mail.ru, даже если для входа на сервис через браузер Вы используете только первую часть записи(YourMail).
  • sPass - пароль доступа к Вашей учетной записи, который Вы используете для входа в почту.

Это основные моменты. Поля Кому(sTo), От кого(sFrom),Тема письма(sSubject), Текст письма(sBody) и Вложение(sAttachment) думаю не нуждаются в расшифровке.

Чтобы использовать данный код вы можете либо просто скопировать его прямо со страницы, либо скачать файл. В файле программа немного упрощена к использованию - в ячейки листа вам необходимо будет внести поля: Кому(sTo), От кого(sFrom),Тема письма(sSubject), Текст письма(sBody) и Вложение(sAttachment) и выбрать SMTPserver. SMTPserver выбирается из выпадающего списка. Сам список является динамическим и расположен на листе "Settinngs". Там же расположены поля Учетной записи и Пароль, которые автоматически подставляются в необходимые поля на листе "Отправка". Т.к. список динамический Вы можете просто добавлять к уже имеющимся новые сервисы и потом просто выбирать их из списка. Так же в файле есть еще одна возможность - выбрать файл. Для этого надо просто нажать на кнопку и выбрать файл.

Скачать пример:

  Tips_Macro_SendMailCDO.xls (69,5 KiB, 5 295 скачиваний)



Ввиду все более участившихся вопросов о том, как добавить к тексту письма картинку именно через CDO - описываю как это можно сделать. Я приведу лишь самый главный кусок кода - создание непосредственно сообщения. Весь остальной код остается таким же, как приведен выше.

With oCDOMsg Set .Configuration = oCDOCnf .From = sFrom .BodyPart.Charset = "windows-1251" .To = sTo .Subject = sSubject Set objbp = oCDOMsg.AddRelatedBodyPart("C:\Документы\Изображения\11.jpg", "11.jpg", 1) objbp.Fields.Item("urn:schemas:mailheader:Content-ID") = "<11.jpg>" objbp.Fields.Update If Len(sAttachment) > 0 Then .AddAttachment sAttachment 'для вложения картинки письмо лучше формировать в формате HTML .HTMLBody = sBody .Send End With


1

2

3

4

5

6

7

8

9

10

11

12

13

14

With oCDOMsg

    Set .Configuration = oCDOCnf

    .From = sFrom

    .BodyPart.Charset = "windows-1251"

    .To = sTo

    .Subject = sSubject

    Set objbp = oCDOMsg.AddRelatedBodyPart("C:\Документы\Изображения\11.jpg", "11.jpg", 1)

    objbp.Fields.Item("urn:schemas:mailheader:Content-ID") = "<11.jpg>"

    objbp.Fields.Update

    If Len(sAttachment) > 0 Then .AddAttachment sAttachment

    'для вложения картинки письмо лучше формировать в формате HTML

    .HTMLBody = sBody

    .Send

End With


Самый главный момент:
AddRelatedBodyPart

C:\Документы\Изображения\11.jpg - указывается полный путь к файлу картинки на компьютере, включая расширение файла.
11.jpg - указывается имя картинки с расширением. Это имя будет использовано внутри письма и именно его необходимо будет указать дальше в "urn:schemas:mailheader:Content-ID". И указывать обязательно в треугольных скобках: "<11.jpg>"

Также см.:
Отправка листа/книги по почте
Вставить в письмо подпись из Outlook через VBA
Вставить в письмо Outlook таблицу Excel с форматированием

Прикрепленные файлы:
Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования