'процедура отправки сообщения по почте
'RecepientName - имя получателя, RecepientAddress - адрес получателя, Subject - заголовок сообщения
'Body - текст сообщения, Attachments - вложенные файлы
Sub SendEmailProc(RecepientName As String, RecepientAddress As String, _
Subject As String, _
Body As String, _
Attachments)
On Error GoTo Err
Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)
With Itm
.Subject = Subject
.To = RecepientName & " <" & RecepientAddress & ">"
'.CC = 'some@cc.ru' 'если нужно, указывается адрес для дополнительного ресипиента
.Body = Body
Dim I As Long
For I = 0 To UBound(Attachments)
.Attachments.Add (Attachments(I)) ' Must be complete path
Next
.Display ' если нужно, чтобы отправляющий увидел бы окно своего сообщения и сам бы нажал кнопку Send
'.Send 'если нужно, чтобы сообщение было отправлено автоматически
End With
Set App = Nothing
Set Itm = Nothing
Exit Sub
Err:
Err.Raise Err.Number, "SendEmailProc", Err.Description
Exit Sub
End Sub
Пример: отправляем выбранному получателю два файла с диска С: FilesArchive1.rar и FilesArchive2.rar
RowSource (источник данных) комбо-бокса запрос, результат которого, например:
Процедура SEND E-MAIL:
Private Sub btnSendEMail_Click()
Call SendEmailProc([Forms]![SendEmail]![cbComboBoxName].Column(1), _
[Forms]![SendEmail]![cbComboBoxName].Column(2), _
"REPORT, " & Format(Now(), "DD.MM.YYYY"), _
"Уважаемый " & [Forms]![SendEmail]![cbComboBoxName].Column(1) & _
", получите Ваш REPORT", _
Array("c:\FilesArchive1.rar", "c:\FilesArchive2.rar"))
End Sub
Результат:
См. также: