Как отправить сообщение через Outlook в HTML в теле письма

@Arcangel · Регистрация: 16.04.2020

Студворк — интернет-сервис помощи студентам

Всем здоровья !
Помогите чайнику, второй день мучаюсь, знаний 0.
Нужно отправить сообщение из разделенной Формы через Outlook , в HTML ! данные текущей записи вида (см. вложение, табличку получил вставкой Ctrl+V, так как не знаю как из буфера вставить в SendObject ) и даже при вставке вручную он удаляет таблицу. Как я понял SendObject не может отправлять HTML в теле.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Private Sub SendMsg_Click()
    DoCmd.RunCommand acCmdSelectRecord
    DoCmd.RunCommand acCmdCopy     'скопировал в буфер
'    DoCmd.RunCommand acCmdPaste   'как вставить в тело сообшения ?
    On Error GoTo ErrorMsg
    DoCmd.SendObject acSendNoObject, , , Me![Почта МК], , , "Уведомление: Заказ-наряд № " & Me![Заказ-наряд] & "   " & Me![Марка] & "   " & Me![Госномер], "как сюда вставить из буфера в HTML"
    GoTo Ends:
ErrorMsg:
    MsgBox ("Отправка уведомления отменена")
Ends:
End Sub

Знаю есть другой метод который решает эту проблему, но прикрутить его к своей базе не получается. Пример с которого пытался сделать во вложении, не знаю как приделать модуль SendMsg , выдает ошибку Объект objOL не найден. И как вставлять активную запись на форме не через буфер а по человечески )

@Navvigator · 24.04.2020, 01:15

Сообщение от Arcangel

Как я понял SendObject не может отправлять HTML в теле.

Тогда вложением отправляйте:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 Public Function otprdog(email As String, kod As Integer) ''''''Старое отправление
 
   Dim myItem As Outlook.MailItem
   Dim myOlApp As Object
   Dim myNameSpace
   
   Set myOlApp = CreateObject("Outlook.Application")
   Set myNameSpace = myOlApp.GetNamespace("MAPI")
   'Set myFolder = myNameSpace.GetDefaultFolder(olFolderContacts)
   Set myItem = myOlApp.CreateItem(olMailItem)
   With myItem
        .To = email              'кому
        .BodyFormat = olFormatHTML
        .Subject = "бла-бла-бла"        'тема
        .HTMLBody = "Здравствуйте! Вам письмо " 'текст
        .Attachments.Add "C:\мойфайл.pdf" ' вложение
   End With
   
    myItem.Display
 End Function

Файл создать сможете?

@Eugene-LS · 24.04.2020, 07:05

Сообщение от Arcangel

в HTML !

Именно в HTML ? - и такое возможно ....
Ну тогда преобразовываем текст в HTML:

Кликните здесь для просмотра всего текста

Visual Basic
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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
Public Function TextToHTML(v As Variant, Optional bForPREtag As Boolean = False) As String
' es  21.12.2015- 21.12.2017 LE
' Исправление текста под HTML - Возвращает модифицированный текст
' Исходная таблица: http://htmlweb.ru/html/symbols.php (обрабатывается пока не всё)
'--------------------------------------------------------------------
'Аргументы:
'   v           = Преобразуемые данные
'   bForPREtag  = ЭТО КОД! с мат. операциями и т.д внутри тега <PRE> (всё немного иначе)
'--------------------------------------------------------------------
Dim strTemp As String
On Error GoTo TextToHTMLErr
    If IsNull(v) = True Then
        TextToHTML = ""
        Exit Function
    End If
    strTemp = CStr(v)
 
'Aghtung!!! - ЗНАК: "&" - ставиться перед спецсимволами!!!
'ЕГО В ПЕРВУЮ ОЧЕРЕДЬ! - иначе будет каша из двойного прекодирования
    strTemp = Replace(strTemp, "&", "&amp;")      'амперсанд
 
'--------------------------------------------------------------------
'Теперь остальное
'   Специальные символы
'   strTemp = Replace(strTemp, "–", "&ndash;")    'узкое тире (en-тире)
'   strTemp = Replace(strTemp, "—", "&mdash;")    'широкое тире (em -тире)
    strTemp = Replace(strTemp, "©", "&copy;")     'копирайт
    strTemp = Replace(strTemp, "®", "&reg;")      'знак зарегистрированной торговой марки
    strTemp = Replace(strTemp, "™", "&trade;")    'знак торговой марки
    strTemp = Replace(strTemp, "¦", "&brvbar")    'вертикальный пунктир
    strTemp = Replace(strTemp, "§", "&sect;")     'параграф
    strTemp = Replace(strTemp, "°", "&deg;")      'градус
'   strTemp = Replace(strTemp, "µ", "&micro;")    'знак "микро"
'   strTemp = Replace(strTemp, "¶", "&para;")     'знак абзаца
'   strTemp = Replace(strTemp, "…", "&hellip;")   'многоточие
'   strTemp = Replace(strTemp, "№", "№")    'знак номера
    
'знаки арифметических и математических операций
    strTemp = Replace(strTemp, "<", "&lt;")       'меньше (Начало тега!)
    strTemp = Replace(strTemp, ">", "&gt;")       'больше (Конец тега!)
    strTemp = Replace(strTemp, "±", "&plusmn;")   'плюс/минус
'    strTemp = Replace(strTemp, "1/4", "&frac14;") 'одна четвертая
'    strTemp = Replace(strTemp, "1/2", "&frac12;") 'одна вторая
'    strTemp = Replace(strTemp, "3/4", "&frac34;") 'три четверти
'    strTemp = Replace(strTemp, "-", "&minus;")    'минус
    
'знаки валют
    strTemp = Replace(strTemp, "€", "&euro;")      'Евро
 
'кавычки
    'strTemp = Replace(strTemp, """", "&quot;")     'двойная кавычка
    strTemp = Replace(strTemp, "«", "&laquo;")     'левая типографская кавычка (кавычка-елочка)
    strTemp = Replace(strTemp, "»", "&raquo;")     'правая типографская кавычка (кавычка-елочка)
    strTemp = Replace(strTemp, "‘", "&lsquo;")     'левая верхняя одинарная кавычка
    strTemp = Replace(strTemp, "’", "&rsquo;")     'правая верхняя одинарная кавычка
    strTemp = Replace(strTemp, "‚", "&sbquo;")     'правая нижняя одинарная кавычка
    strTemp = Replace(strTemp, "“", "&ldquo;")     'кавычка-лапка левая
    strTemp = Replace(strTemp, "”", "&rdquo;")     'кавычка-лапка правая верхняя
    strTemp = Replace(strTemp, "„", "&bdquo;")     'кавычка-лапка правая нижняя
    
'знаки арифметических и математических операций
    'strTemp = Replace(strTemp, "‹", "‹")     'одинарная угловая кавычка открывающая
    'strTemp = Replace(strTemp, "›", "›")     'одинарная угловая кавычка закрывающая
 
    If bForPREtag = False Then 'внутри тега <PRE> - ненужно
    '002! - Поск и замена пробелов и TAB-ов в тексте ...
        'TAB-ы (допустим) меняем на 4 пробела подряд ("&nbsp;")
        strTemp = Replace(strTemp, vbTab, "&nbsp;&nbsp;&nbsp;&nbsp;") '4шт
        strTemp = Replace(strTemp, "   ", "&nbsp;&nbsp;&nbsp;") '3 шт.
        strTemp = Replace(strTemp, "  ", "&nbsp;&nbsp;")       '2 шт - а можно и пропустить...
 
    '003! -  ... Перевод строки
        strTemp = Replace(strTemp, vbCrLf, "<br>" & vbCrLf)
    Else 'внутри тега <PRE>
        strTemp = Replace(strTemp, vbTab, " ") 'Табулятор - Только внутри PRE тега
    End If
    
    TextToHTML = strTemp
 
TextToHTMLBye:
    Exit Function
 
TextToHTMLErr:
    TextToHTML = ""
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in procedure TextToHTML", vbCritical, "Error!"
    Resume TextToHTMLBye
End Function

Отправляем:

Кликните здесь для просмотра всего текста

Visual Basic
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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
Public Sub SendEmailWtAttachment(sToEMails$, sSybject$, Optional sBody$, _
        Optional sAttachmentPath$, Optional sSaveCopyToFolder$)
'es 16.02.05 - 06.05.2017
'----------------------------------------------------------------------------
'MS Access VBA - процедура отправки сообщения посредством MS OutLook
'с вложением (опционально) и сохранением файла копии (опционально)
'es 16.02.05 - 06.05.2017
'----------------------------------------------------------------------------
'Аргументы:
'   sToEMails          'Адрес, или адреса через точку с запятой
'   sSybject           'Тема
'   sBody              'Текст (тело сообщения)
'   sAttachmentPath    'Полный путь к вложению (опционально)
'   sSaveCopyToFolder  'Путь к к папке куда сохранить копию (опционально)
'----------------------------------------------------------------------------
'Полезная инфа:
'   * MailItem Object (Outlook)
'   https://msdn.microsoft.com/ru-ru/library/office/ff861332.aspx
'   * OlItemType Enumeration (Outlook)
'   https://msdn.microsoft.com/ru-ru/library/office/ff869291.aspx
'----------------------------------------------------------------------------
 
Dim olObjApp As Object      'Ссылка на MS Outlook
Dim olObjItem As Object     'Ссылка на сообщение
Dim s$
 
On Error GoTo SendEmailWtAttachmentErr
 
    Set olObjApp = CreateObject("Outlook.Application")
    Set olObjItem = olObjApp.CreateItem(0) '0 = письмишко значит ...
    '* cм https://msdn.microsoft.com/ru-ru/library/office/ff869291.aspx
    
'Создание сообщения
    With olObjItem
        .To = sToEMails          'кому
        .Subject = sSybject      'тема
        .Body = sBody            'текст
 
        '*  Если нужно несколько вложений - можно поиграть с коллекцией ниже
        '*  и именить аргумент процедуры на массив например, но не будем усложнять
        If sAttachmentPath <> "" Then
            If Dir(sAttachmentPath) <> "" Then
                .Attachments.Add sAttachmentPath
            End If
        End If
        
        '.Display 'Отображение сообщения (если нужно)
        .Save    'Сохранение сообщения (пока в Черновиках)
        
        'Но это не фактическая отправка, а только помещение в папку "Исходящие" (OutBox)
        .Send
        '... а далеше OutLook будет действовать по своим настройкам ("Мгновенная отправка")
 
'Экспортирование - если указан аргумент
        If sSaveCopyToFolder <> "" Then
            s = sSaveCopyToFolder
            If Right(s, 1) <> "\" Then s = s & "\"
            
            ' а можно м с этим: .EntryID = строчка в 50 (!!!) симсолов
            s = s & sSybject & ".msg" 'Путь сохранения копии
            Debug.Print s
            .SaveAs s, 3 'Схраняем ...
            '... и тут 3 = olObjSaveAsMsg (MS OutLook Format *.msg)
        End If
    
 
    End With
    
    Set olObjItem = Nothing
    Set olObjApp = Nothing
    Exit Sub
    
SendEmailWtAttachmentErr:
   If Err.Number = "287" Then 'На всякий случай
      MsgBox "Вы отказались от создания сообщения!", vbInformation, "Сообщение не создано"
   Else
      MsgBox Err.Description, vbCritical, "Error!"
   End If
End Sub

Новые блоги и статьи Все статьи Все блоги /
Отображение реквизитов в документе по условию и контроль их заполнения Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеСпецтехники", разработанного в конфигурации КА2. Данный документ берёт данные из другого нетипового документа. . .	Фото всей Земли с борта корабля Orion миссии Artemis II kumehtar 04.04.2026 Это первое подобное фото сделанное человеком за 50 лет. Снимок называют новым вариантом легендарной фотографии «The Blue Marble» 1972 года, сделанной с борта корабля «Аполлон-17». Новое фото. . .	Вывод диалогового окна перед закрытием, если документ не проведён Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: реализовать программный контроль на предмет проведения документа. . .	Программный контроль заполнения реквизита табличной части документа Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: реализовать контроль заполнения реквизита "ПричинаСписания". . .
wmic не является внутренней или внешней командой Maks 02.04.2026 Решение: DISM / Online / Add-Capability / CapabilityName:WMIC~~~~ Отсюда: https:/ / winitpro. ru/ index. php/ 2025/ 02/ 14/ komanda-wmic-ne-naydena/	Программная установка даты и запрет ее изменения Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: при создании документов установить период списания автоматически. . .	Вывод данных в справочнике через динамический список Maks 01.04.2026 Реализация из решения ниже выполнена на примере нетипового справочника "Спецтехника" разработанного в конфигурации КА2. Задача: вывести данные из ТЧ нетипового документа. . .	Программное заполнения текстового поля в реквизите формы документа Maks 01.04.2026 Алгоритм из решения ниже реализован на нетиповом документе "ВыдачаОборудованияНаСпецтехнику" разработанного в конфигурации КА2, в дополнении к предыдущему решению. На форме документа создается. . .