Отправить письмо

После того, как отчет был сформирован, хорошо было бы отправить его получателям. Для этого нужно сделать следующее:

   Dim OutApp As Object

   Dim OutMail As Object

   Set OutApp = CreateObject("Outlook.Application")

   Set OutMail = OutApp.CreateItem(0)

   With OutMail

       .To="mail@mail.ru"

       .CC = ""

       .BCC = ""

       .Subject = "Тема письма"

       .Body = "Тело письма"

       .Attachments.Add FullName_of_WorkBook

       .Send

   End With

'\\==============================================================================

 Sub test_Mail_Sent()

Call Mail_Sent(bln_Sent:=False, _

strMail_To:="xxxxxxxxxxx", _

strMail_CC:="", _

strMail_BCC:="", _

strMail_Subject:="test", _

strMail_Body:=" Добрый день." & vbCrLf & _

"1. qwerty" & vbCrLf & _

"2. qwerty" & vbCrLf & _

"3. qwerty", _

strMail_Attach:="")

End Sub

Sub Mail_Sent(ByVal bln_Sent As Boolean, _

ByVal strMail_To As String, _

ByVal strMail_CC As String, _

ByVal strMail_BCC As String, _

ByVal strMail_Subject As String, _

ByVal strMail_Body As String, _

ByVal strMail_Attach As String)

Dim OutApp As Object

Dim OutMail As Object

If OutApp Is Nothing Then

Set OutApp = ConnectOutlook() 'CreateObject("Outlook.Application")

IsNotAppRun = True

End If

Set OutMail = OutApp.CreateItem(0)

With OutMail

.To = strMail_To

.CC = strMail_CC

.BCC = strMail_BCC

.Subject = strMail_Subject

.Body = strMail_Body

If Len(Trim(strMail_Attach)) > 0 Then .Attachments.Add strMail_Attach

If bln_Sent Then

.Send

Else

.Display

End If

End With

If IsNotAppRun Then Set OutApp = Nothing

End Sub

Function ConnectOutlook() As Variant

'подключаемся к Outlook

On Error Resume Next

Set objOutlApp = GetObject(, "outlook.Application")

If objOutlApp Is Nothing Then

Set objOutlApp = CreateObject("outlook.Application")

IsNotAppRun = True

End If

Set ConnectOutlook = objOutlApp

End Function

Если не хочешь отправлять письмо сразу, а хочешь сначала взглянуть на окно отправки, то меняем слово Send на Display