VBA отправить почту

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long



Sub Send_Email_Using_VBA()
Dim Email_Subject, Email_Send_From, Email_Send_To, _
Email_Cc, Email_Bcc, Email_Body As String
Dim Mail_Object, Mail_Single As Variant
Email_Subject = "Ïîïûòêà îòïðàâèòü ïèñüìî ñ ïîìîùüþ VBA"
Email_Send_From = "exceltipmail@gmail.com"
Email_Send_To = "exceltipmail@gmail.com"
Email_Cc = "exceltipmail@gmail.com"
Email_Bcc = "exceltipmail@gmail.com"
Email_Body = "Ïîçäðàâëÿåì!!!! Âàøå ïèñüìî óñïåøíî îòïðàâëåíî !!!!"
On Error GoTo debugs
Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)
With Mail_Single
.Subject = Email_Subject
.To = Email_Send_To
.CC = Email_Cc
.BCC = Email_Bcc
.Body = Email_Body
.Send
End With
debugs:
If Err.Description <> "" Then MsgBox Err.Description
End Sub


' Åñëè âû èñïîëüçóåòå Gmail àêêàóíò èñïîëüçóéòå ýòîò ïðèìåð ñåðâåðà SMTP
' Äàííûé ïðèìåð îòïðàâëÿåò êîðîòêîå òåêñòîâîå ñîîáùåíèå
' Âàì ïîòðåáóåòñÿ èçìåíèòü ÷åòûðå ñòðîêè êîäà, ÷òîáû ïðîòåñòèðîâàòü ïðèìåð

'.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Ïîëíûé àäðåñ âàøåãî GMail ÿùèêà"
'.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "GMail ïàðîëü"

' Èñïîëüçóéòå ñîáñòâåííûé àäðåñ ýëåêòðîííîé ïî÷òû äëÿ ïðîâåðêè ðàáîòîñïîñîáíîñòè êîäà
'.To = "Ïî÷òîâûé àäðåñ ïîëó÷àòåëÿ"

' Èçìåíèòå ÂàøåÈìÿ íà èìÿ îòïðàâèòåëÿ
'.From = """ÂàøåÈìÿ"" <Îòâåòèòü@êîìó-òî.ru>"

'Åñëè ó âàñ âûñêàêèâàåò îøèáêà : Òðàíñïîðòó íå óäàëîñü ïîäêëþ÷èòüñÿ ê ñåðâåðó
'ïîïðîáóéòå ïîìåíÿòü SMTP ïîðò ñ 465 íà 25

Sub Send_Email_Using_CDO()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    iConf.Load -1
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Ïîëíûé àäðåñ âàøåãî GMail ÿùèêà"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "GMail ïàðîëü"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
        .Update
    End With
   
    strbody = "Ïîçäðàâëÿåì!!!! Âàøå ïèñüìî óñïåøíî îòïðàâëåíî !!!!"
   
    With iMsg
        Set .Configuration = iConf
        .To = "Ïî÷òîâûé àäðåñ ïîëó÷àòåëÿ"
        .CC = ""
        .BCC = ""
        .From = """Ðåíàò"" <Reply@something.nl>"
        .Subject = "Ïîïûòêà îòïðàâèòü ïèñüìî ñ ïîìîùüþ CDO"
        .TextBody = strbody
        .Send
    End With
End Sub

Sub Send_Email_Using_Keys()
 Dim Mail_Object As String
 Dim Email_Subject, Email_Send_To, Email_Cc, Email_Bcc, Email_Body As String
 Email_Subject = "Ïîïûòêà îòïðàâèòü ïèñüìî ñ ïîìîùüþ SendKeys"
 Email_Send_To = "exceltipmail@gmail.com "
 Email_Cc = "exceltipmail@gmail.com "
 Email_Bcc = "exceltipmail@gmail.com "
 Email_Body = "Ïîçäðàâëÿåì!!!! Âàøå ïèñüìî óñïåøíî îòïðàâëåíî ñ ïîìîùüþ SendKeys !!!!"

 Mail_Object = "mailto:" & Email_Send_To & "?subject=" & Email_Subject & "&body=" & Email_Body & "&cc=" & Email_Cc & "&bcc=" & Email_Bcc

 On Error GoTo debugs
 ShellExecute 0&, vbNullString, Mail_Object, vbNullString, vbNullString, vbNormalFocus
 Application.Wait (Now + TimeValue("0:00:03"))
 Application.SendKeys "^({ENTER})"
 Application.SendKeys ("{ENTER}")
debugs:
 If Err.Description <> "" Then MsgBox Err.Description
 End Sub

==================================================================

exceltip.ru