Отправка писем из exel с Body.html

Петр · 02.08.2014, 23:39:14

Добрый день! :D Уважаемые знатоки помогите, пожалуйста!

Что хочу получить:
Необходимо отправлять сообщения из exel в вконтакте с вложенным файлом (фотография)

Дано:
1) http://www.excel-vba.ru/chto-umeet-excel/kak-otpravit-pismo-iz-excel/ тут есть файл из которого можно отправлять письмо напрямую из exel.
2) http://www.excel-vba.ru/forum/index.php?topic=828.0;wap2 тут предполагаемое решение одной из проблем (но я ничер*а не понимаю)

Проблемы

:
1) вложенный файл вконтакте не воспринимает по этому требуется прописать тело письма в html
2) отсутствует сохранение отправленных писем (как вариант можно поставить еще 1го получателя для сохранения но все таки...)

Заранее благодарю за любую оказанную помощь!!!!

Юрий М · 03.08.2014, 10:58:57

Кросс на Планете

Петр · 03.08.2014, 11:18:41

это я и содзал, чтоб охватить больше знающих людей! А кроме ссылки на эту же тему есть какие то идеи?

Юрий М · 03.08.2014, 12:31:25

Есть идея - ознакомиться с Правилами. Там и про создание тем на нескольких форумах есть. На Планете, кстати, тоже. Тогда Вас станет понятно, почему я создал свой пост.
Никто не запрещает создавать одинаковые темы хоть на сотне форумах - только ИНФОРМИРУЙТЕ об этом...

Петр · 03.08.2014, 12:55:00

С правилами я ознакомился прежде чем разместить тему. Вот то что запрещено:
"На данном форуме запрещено (то же что и на всех остальных форумах):
оскорблять посетителей форума и сайта, а также Модераторов форума, Администрацию сайта;
выражаться нецензурно, хамить;
выкладывать ссылки на интернет-ресурсы порнографического содержания;
выкладывать ссылки на интернет-ресурсы, не имеющие ничего общего с тематикой форума;"

Вроде бы ничего не нарушал. Пункт про создание тем на нескольких форумах не нашел...

Также Вы меня не совсем поняли. Когда я написал "идеи" я имел ввиду те идеи которые конкретно относятся к заданному вопросу. Наверно я сам виноват, что не объяснил это сразу. И если у возникнут идеи согласно тех проблем, которые мне не удается решить в exel, то ОБЯЗАТЕЛЬНО напишите. Я буду очень признателен.

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

Юрий М · 03.08.2014, 13:15:27

ЦитироватьПункт про создание тем на нескольких форумах не нашел..

Смотрим п. 4.24 Есть там такой?

Петр · 03.08.2014, 13:26:25

эм возможно я не там смотрю... http://www.excel-vba.ru/forum/index.php?topic=3.0
Подскажите Юрий М. как на Ваш профессиональный взгляд насколько мой вопрос трудный и как вы думаете есть ли вероятность получить ответ по возникшей проблеме. Или же (как я уже догадываюсь) тема закончится обсуждением правил форума?

Дмитрий Щербаков(The_Prist) · 03.08.2014, 15:29:00

Петр, давайте разбираться с самого начала. Вы каким методом пробуете отправить письмо? через Outlook или CDO?

Петр · 03.08.2014, 15:40:38

не через Outlook вот файл https://yadi.sk/i/zU8r5iXEYwwgs

Дмитрий Щербаков(The_Prist) · 03.08.2014, 16:19:11

Тогда советую на той же странице с примерами кодов почитать комментарии - начиная с 4-ой страницы. Как раз разбиралось как внедрить картинку в тело письма.
Вот один код:

Код (vb) Выделить

    sBody = "<HTML><HEAD><BODY><b> <img src=""pic""> картинка</b></br></BODY></HTML>"
    With oCDOMsg
        Set .Configuration = oCDOCnf
        .From = sFrom
        .BodyPart.Charset = "windows-1251"
        .To = sTo
        .Subject = sSubject
        If Len(sAttachment) > 0 Then .AddAttachment sAttachment
        .AddRelatedBodyPart "C:\image.jpg", "pic", 1
        .HTMLBody = sBody
        .Send
    End With

вот второй

Код (vb) Выделить

    sBody = "<HTML><HEAD><BODY><b> <img src="cid:1.jpg"> картинка</b></br></BODY></HTML>"
    With oCDOMsg
        Set .Configuration = oCDOCnf
        .From = sFrom
        .BodyPart.Charset = "windows-1251"
        .To = sTo
        .Subject = sSubject
        Set objbp = oCDOMsg.AddRelatedBodyPart("d:\temp\1.jpg", "1.jpg", CdoReferenceTypeName)
        objbp.Fields.Item("urn:schemas:mailheader:Content-ID") = ""
        objbp.Fields.Update
        If Len(sAttachment) > 0 Then .AddAttachment sAttachment
        .AddRelatedBodyPart "C:\image.jpg", "pic", 1
        .HTMLBody = sBody
        .Send
    End With

Петр · 03.08.2014, 17:18:06

Чувствую себя идиотом... даже не знаю в какие строки код вставить... ладно постараюсь поколдовать. Как только разберусь отправлю благодарность (я так понимаю на 41001332272872).
А по поводу сохранения отправленного письма есть какие то пути реализации?

Дмитрий Щербаков(The_Prist) · 03.08.2014, 18:00:14

Полностью для файла в статье код будет таким:

Код (vb) Выделить

'---------------------------------------------------------------------------------------
' Procedure : Send_Mail
' Purpose   : Процедура отправки письма
'---------------------------------------------------------------------------------------
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 = [B10]    ' SMTPServer: для Mail.ru "smtp.mail.ru"; для Яндекса "smtp.yandex.ru"; для Рамблера "mail.rambler.ru"
    sUsername = [B11]   ' Учетная запись на сервере
    sPass = [B12]    ' Пароль к почтовому аккаунту

    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 = [B2]    'Кому
    sFrom = [B3]    'От кого
    sSubject = [B4]    'Тема письма
    sBody = [B5]    'Текст письма
    sAttachment = [B6]    'Вложение(полный путь к файлу)
    'Проверка наличия файла по указанному пути
    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
        .Item(CDO_Cnf & "sendusername") = sUsername
        .Item(CDO_Cnf & "sendpassword") = sPass
        .Update
    End With
    'Создаем сообщение
    Set oCDOMsg = CreateObject("CDO.Message")
    sBody = "<HTML><HEAD><BODY><b> <img src=""cid:1.jpg""> картинка</b></br></BODY></HTML>"
    With oCDOMsg
        Set .Configuration = oCDOCnf
        .From = sFrom
        .BodyPart.Charset = "windows-1251"
        .To = sTo
        .Subject = sSubject
        Set objbp = oCDOMsg.AddRelatedBodyPart("d:\temp\1.jpg", "1.jpg", CdoReferenceTypeName)
        objbp.Fields.Item("urn:schemas:mailheader:Content-ID") = ""
        objbp.Fields.Update
        If Len(sAttachment) > 0 Then .AddAttachment sAttachment
        .AddRelatedBodyPart "d:\temp\1.jpg", "pic", 1
        .HTMLBody = sBody
        .Send
    End With

    Select Case Err.Number
    Case -2147220973: sMsg = "Нет доступа к Интернет"
    Case -2147220975: sMsg = "Отказ сервера SMTP"
    Case 0: sMsg = "Письмо отправлено"
    End Select
    MsgBox sMsg, vbInformation, "www.Excel-VBA.ru"
    Set oCDOMsg = Nothing: Set oCDOCnf = Nothing
End Sub

Картинка берется из папки d:\temp\ и называется 1.jpg.

По поводу оставления в отправленных - по крайней мере мне не известен способ дублирования в папке отправленные.

Петр · 03.08.2014, 22:18:28

Почему то выдает такую ошибку http://i7.pixs.ru/storage/4/7/6/02ab661db5_6627206_13260476.jpg
И я правильно понимаю что картинка будет отправляться только одна, чтоб ее заменить нужно каждый раз редактировать код?

Дмитрий Щербаков(The_Prist) · 03.08.2014, 22:41:26

Ошибка означает, что я не глянул как криво интерпретировался код. Так верно:

Код Выделить

' Procedure : Send_Mail
' Purpose   : Процедура отправки письма
'---------------------------------------------------------------------------------------
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 = [B10]    ' SMTPServer: для Mail.ru "smtp.mail.ru"; для Яндекса "smtp.yandex.ru"; для Рамблера "mail.rambler.ru"
    sUsername = [B11]   ' Учетная запись на сервере
    sPass = [B12]    ' Пароль к почтовому аккаунту

    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 = [B2]    'Кому
    sFrom = [B3]    'От кого
    sSubject = [B4]    'Тема письма
    sBody = [B5]    'Текст письма
    sAttachment = [B6]    'Вложение(полный путь к файлу)
    'Проверка наличия файла по указанному пути
    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
        .Item(CDO_Cnf & "sendusername") = sUsername
        .Item(CDO_Cnf & "sendpassword") = sPass
        .Update
    End With
    'Создаем сообщение
    Set oCDOMsg = CreateObject("CDO.Message")
    sBody = "<HTML><HEAD><BODY><b> <img src=""cid:1.jpg""> картинка</b></br></BODY></HTML>"
    With oCDOMsg
        Set .Configuration = oCDOCnf
        .From = sFrom
        .BodyPart.Charset = "windows-1251"
        .To = sTo
        .Subject = sSubject
        Set objbp = oCDOMsg.AddRelatedBodyPart("d:\temp\1.jpg", "1.jpg", CdoReferenceTypeName)
        objbp.Fields.Item("urn:schemas:mailheader:Content-ID") = ""
        objbp.Fields.Update
        If Len(sAttachment) > 0 Then .AddAttachment sAttachment
        .AddRelatedBodyPart "d:\temp\1.jpg", "pic", 1
        .HTMLBody = sBody
        .Send
    End With

    Select Case Err.Number
    Case -2147220973: sMsg = "Нет доступа к Интернет"
    Case -2147220975: sMsg = "Отказ сервера SMTP"
    Case 0: sMsg = "Письмо отправлено"
    End Select
    MsgBox sMsg, vbInformation, "www.Excel-VBA.ru"
    Set oCDOMsg = Nothing: Set oCDOCnf = Nothing
End Sub

Чтобы вставлять несколько картинок, необходимо повторить строки:

Код (vb) Выделить

Set objbp = oCDOMsg.AddRelatedBodyPart("d:\temp\1.jpg", "1.jpg", CdoReferenceTypeName)  
objbp.Fields.Item("urn:schemas:mailheader:Content-ID") = ""  
objbp.Fields.Update

и

Код (vb) Выделить

.AddRelatedBodyPart "d:\temp\1.jpg", "pic", 1
и соответственно, добавить ссылку на картинку в теле письма(sBody).

Петр · 03.08.2014, 23:47:24

Спасибо за помощь! Как и обещал http://i6.pixs.ru/storage/4/7/6/11jpg_2254551_13261476.jpg
Не закрывайте пока тему, возможно будут вопросы...

Новости:

Отправка писем из exel с Body.html