MS OutLook - Создание и отправка сообщения с вложением (опционально) и экспортом в файл копии (опционально)Полезная инфа: 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 |
|||
L.E. 26.12.2022 |