Страницы: 1
RSS
Отправка письма через CDO
 
Добрый день!

 Для отправки письма использую следующий код (ниже).
Т.к. VBA не знаю, не могу справиться со следующей задачей. Необходимо в тело письма вставить определенный диапазон ячеек, напр: A1:C10, с сохранением форматирования. Т.е тело письма будет в формате HTML с вставленной таблицей, визуально выглядевшей как на листе Excel.

Прошу помочь решить данную задачу, к сожалению сам ответа не нашел.

Заранее спасибо
Код
Sub SendMail()

    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 = "192....."    ' SMTPServer: 
    sUsername = ""    ' Учетная запись на сервере
    sPass = "***"    ' Пароль к почтовому аккаунту

    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 = "***    'Кому
    sFrom = "**    'От кого
    sSubject = "Тема" & [E3] 'Тема письма

    sBody = "Тест " & [B10] & "   " & [E10] & "" & _
    vbCrLf & [B11] & "   " & [E11] & "" & _
  
'    sAttachment = "C:\1\" & [E3] & ".xlsx"      'Вложение(полный путь к файлу)


    'Назначаем конфигурацию 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"
    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 = "Письмо отправлено"
    End Select
    MsgBox sMsg, vbInformation, " newgsm (c)"
    Set oCDOMsg = Nothing: Set oCDOCnf = Nothing
End Sub
Изменено: alexcel77 - 23.04.2015 14:27:43
 
alexcel77, оформление кода - кнопка <...>,
спрятать под спойлер простыню - кнопка "SP"
Прошу исправить сообщение.
 
Вообще поищите по форуму: таблица в письмо Outlook. Принцип тот же. Только .TextBody надо будет заменить на .HTMLBody
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Проблема в том что в Outlook не настроена ни одна учетная запись, и настраивать ее нельзя, поэтому и пытаюсь через CDO.
 
Эх...Я же написал - принцип тот же. Я не говорю, что через Outlook надо делать. Я написал поищите, там будет отдельная функция. Её и используйте, только в своем(моем? :-) ) коде заменить .TextBody на .HTMLBody
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Сори, не внимательно прочитал ).
с трудом дается поиск
Код
попробовал вставить     HTMLBody = SheetToHTML(ThisWorkbook.Worksheets("Название листа") 
 
Ругается на SheetToHTML.   Очень плохо ориентируюсь в коде, все на догадках. Если можно ткните носом где искать или подправьте код. Спасибо
Страницы: 1
Наверх