|
Пример применения:
SendEmailWtAttachment "name@domen.ru", "Тема", "Текст Сообщения", "C:Tempfilename.zip"
Причем если необходимо передать сообщение нескольким адресатам, то в строку адреса можно предать несколько адресов разделяя их точкой с запятой и пробелом.
Внимание!!!
с MS OutLook 2000 - отработает с отсылкой - проверено
с MS OutLook XP и выше - ВЫДАСТ сообщение безопасности о том что внешнее приложение пытается ....
Public Sub SendEmailWtAttachment(strTo As String, strSybject As String, _
Optional strBody As String, Optional strAttachmentPath As String)
′es 16.02.05
′----------------------------------------------------------------------------
Dim OlApp As Object ′Ссылка на MS Outlook
Dim OlItem As Object ′Ссылка на сообщение
On Error GoTo SendEmailWtAttachmentErr
′Создание сообщения
Set OlApp = CreateObject("Outlook.Application")
Set OlItem = OlApp.CreateItem(0)
With OlItem
.To = strTo ′кому
.Subject = strSybject ′тема
.Body = strBody ′текст
If strAttachmentPath <> "" Then
If Dir(strAttachmentPath) <> "" Then
.Attachments.Add strAttachmentPath
End If
End If
.Display ′Отображение сообщения
′.Save Сохранение сообщения (пока в Черновиках)
′.Send Отсылка - В версиях старше MS Outlook 2000 выдается сообщение безопасности !!!
′Обход сообщения безопасности ! Через горячие клавиши отсылки...
SendKeys "%m"
End With
DoEvents
Set OlItem = Nothing
Set OlApp = Nothing
Exit Sub
SendEmailWtAttachmentErr:
If Err.Number = "287" Then ′
MsgBox "Вы отказались от создания сообщения!", vbInformation, "Не создано"
Else
MsgBox Err.Description, vbCritical, "Error!"
End If
End Sub | 