Sub Procedura_1()
Application.OnTime Now + TimeValue("00:00:05"), "Send_Mail()"
End Sub

Sub Send_Mail()
Const CDO_Cnf = "http://schemas.microsoft.com/cdo/configuration/"
Dim oCDOCnf As Object, oCDOMsg As Object
Dim SMTPserver As String, sUsername As String, sPass As String, sMsg As String
Dim sTo As String, sFrom As String, sSubject As String, sBody As String, sAttachment As String
On Error Resume Next
'sFrom - êàê ïðàâèëî ñîâïàäàåò ñ sUsername
SMTPserver = [B10] ' SMTPServer: äëÿ Mail.ru "smtp.mail.ru"; äëÿ ßíäåêñà "smtp.yandex.ru"; äëÿ Ðàìáëåðà "mail.rambler.ru"
sUsername = [B11] ' Ó÷åòíàÿ çàïèñü íà ñåðâåðå
sPass = [B12] ' Ïàðîëü ê ïî÷òîâîìó àêêàóíòó

If Len(SMTPserver) = 0 Then MsgBox "Íå óêàçàí SMTP ñåðâåð", vbInformation, "111": Exit Sub
If Len(sUsername) = 0 Then MsgBox "Íå óêàçàíà ó÷åòíàÿ çàïèñü", vbInformation, "111": Exit Sub
If Len(sPass) = 0 Then MsgBox "Íå óêàçàí ïàðîëü", vbInformation, "111": Exit Sub

sTo = [B2] 'Êîìó
sFrom = [B3] 'Îò êîãî
sSubject = [B4] 'Òåìà ïèñüìà
sBody = [B5] 'Òåêñò ïèñüìà
sAttachment = [B6] 'Âëîæåíèå(ïîëíûé ïóòü ê ôàéëó)
'Ïðîâåðêà íàëè÷èÿ ôàéëà ïî óêàçàííîìó ïóòè
If Dir(sAttachment, vbDirectory) = "" Then sAttachment = ""
'Íàçíà÷àåì êîíôèãóðàöèþ CDO
Set oCDOCnf = CreateObject("CDO.Configuration")
With oCDOCnf.Fields
.Item(CDO_Cnf & "sendusing") = 2
.Item(CDO_Cnf & "smtpauthenticate") = 1
.Item(CDO_Cnf & "smtpserver") = SMTPserver
.Item(CDO_Cnf & "sendusername") = sUsername
.Item(CDO_Cnf & "sendpassword") = sPass
.Update
End With
'Ñîçäàåì ñîîáùåíèå
Set oCDOMsg = CreateObject("CDO.Message")
With oCDOMsg
Set .Configuration = oCDOCnf
.BodyPart.Charset = "koi8-r"
.From = sFrom
.To = sTo
.Subject = sSubject
.TextBody = sBody
If Len(sAttachment) > 0 Then .AddAttachment sAttachment
.Send
End With

Select Case Err.Number
Case -2147220973: sMsg = "Íåò äîñòóïà ê Èíòåðíåò"
Case -2147220975: sMsg = "Îòêàç ñåðâåðà SMTP"
Case 0: sMsg = "Ïèñüìî îòïðàâëåíî"
End Select
MsgBox sMsg, vbInformation, "111"
Set oCDOMsg = Nothing: Set oCDOCnf = Nothing
End Sub

Sub Get_File_Path()
Dim sPath
sPath = Application.GetOpenFilename("All Files(*.*),*.*", , "Âûáðàòü ôàéëû", "Âûáðàòü", False)
If sPath = False Then Exit Sub
[B6] = sPath
End Sub