|
|
Отправка E-Mail через CDO.Message (с вложением)
Private Sub Email_Click()
DoCmd.OutputTo acOutputReport, "rptTest", acFormatPDF, "D:\Temp\MyReport.pdf"
DoEvents
SendEmail "906750683@gmail.com", "Test 01", "Проверка кода ...", "D:\Temp\MyReport.pdf"
DoEvents
Kill "D:\Temp\MyReport.pdf"
End Sub
Public Function SendEmail(sTo$, sSubject$, sTextBody$, Optional sAttachment = "")
Dim msg As Object
Dim sConfig As String
On Error GoTo SendEmail_Err
Set msg = CreateObject("CDO.Message")
msg.BodyPart.Charset = "windows-1251"
sConfig = "http://schemas.microsoft.com/cdo/configuration/"
With msg
.To = sTo
.From = "Имя_Пользователя@yandex.ru"
.Subject = sSubject
.TextBody = sTextBody
If Dir(sAttachment) <> "" Then
.AddAttachment (sAttachment)
End If
With .Configuration.Fields
.Item(sConfig & "sendusing") = 2
.Item(sConfig & "smtpserver") = "smtp.yandex.ru"
.Item(sConfig & "smtpauthenticate") = 1
.Item(sConfig & "smtpserverport") = 465
.Item(sConfig & "smtpusessl") = True
.Item(sConfig & "sendusername") = "Имя_Пользователя@yandex.ru"
.Item(sConfig & "sendpassword") = "XXXXXX"
.Item(sConfig & "smtpconnectiontimeout") = 30
.Update
End With
.send
End With
SendEmail_End:
On Error Resume Next
Set msg = Nothing
Exit Function
SendEmail_Err:
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
"in Function: SendEmail in module: mod00Test", vbCritical, "Error in Application"
Err.Clear
Resume SendEmail_End
End Function
|
|