VBA, MS Access MS Access в примерах

MS OutLook - Создание и отправка сообщения с вложением (опционально) и экспортом в файл копии (опционально)

Полезная инфа:
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.  

Пример применения:

    SendEmailWtAttachment "name@domen.ru", "Тема", "Текст Сообщения", "C:\Temp\filename.zip"
    SendEmailWtAttachment "8768972867077@gmail.com", "test01", "Привет!", , "d:\temp"


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

Public Sub SendEmailWtAttachment(sToEMails$, sSybject$, Optional sBody$, _
        Optional sAttachmentPath$, Optional sSaveCopyToFolder$)
'es 16.02.2005 - LE 26.12.2022 v005
'---------------------------------------------------------------------------------------------------
'процедура отправки сообщения посредством MS OutLook с вложением (опционально) и сохранением файла копии (опционально)
'procedure for sending a message via MS OutLook With attachment (optional) and saving copy file (optional)
'---------------------------------------------------------------------------------------------------
'Аргументы: - Arguments:
'   sToEMails          'Адрес, или адреса через точку с запятой - Address, or semicolon addresses
'   sSybject           'Тема - Subject
'   sBody              'Текст (тело сообщения) - Text (message body)
'   sAttachmentPath    'Полный путь к вложению (опционально) - Full path to attachment (optional)
'   sSaveCopyToFolder  'Путь к к папке куда сохранить копию (опционально)
                       'Path to the folder where to save the copy (optional)
'---------------------------------------------------------------------------------------------------
'Usage:
'   SendEmailWtAttachment "name@domen.ru", "Text of Subject", "message ...", "C:\Temp\filename.zip"
'---------------------------------------------------------------------------------------------------

Dim olObjApp As Object      'MS Outlook application
Dim olObjItem As Object     'MS Outlook item (message)
Dim s$

On Error GoTo SendEmailWtAttachmentErr

    Set olObjApp = CreateObject("Outlook.Application")
    Set olObjItem = olObjApp.CreateItem(0)
    '* cм https://msdn.microsoft.com/ru-ru/library/office/ff869291.aspx
    
'Creating message
    With olObjItem
        .To = sToEMails
        .Subject = sSybject
        .Body = sBody

        If sAttachmentPath <> "" Then
            If Dir(sAttachmentPath) <> "" Then
                .Attachments.Add sAttachmentPath
            End If
        End If
        
        'Saving a message (still in "Drafts")
        .Save    'Сохранение сообщения (пока в Черновиках)
        
        'Отправка - Но это не фактическая отправка, а только помещение в папку "Исходящие" (OutBox)
        'Sending - But this is not the actual sending, but only putting it in the Outbox folder (OutBox)
        .Send
        '... а далеше OutLook будет действовать по своим настройкам ("Мгновенная отправка")
        ''...and then OutLook will act on its settings ('Instant Send')

'Экспортирование - если указан аргумент - Export - if the argument is specified
        If sSaveCopyToFolder <> "" Then
            s = sSaveCopyToFolder
            If Right(s, 1) <> "\" Then s = s & "\"

            s = s & sSybject & ".msg" 'Путь сохранения копии - Save copy path
            Debug.Print s
            .SaveAs s, 3
        End If
    

    End With
    
    Set olObjItem = Nothing
    Set olObjApp = Nothing
    Exit Sub
    
SendEmailWtAttachmentErr:
   If Err.Number = "287" Then
      MsgBox "You declined to create a message!", vbInformation, "Сообщение не создано"
   Else
      MsgBox Err.Description, vbCritical, "Error!"
   End If
End Sub





Назад ToTop
L.E. 26.12.2022
Рейтинг@Mail.ru