Такой вариант через yandex.ru работает. А на внутренней почте появляется ошибка "Нет доступа к Интернет". Но там интернет и не нужен.  
Кто знает, как поступить в этом случае?    
 
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, "www.Excel-VBA.ru": Exit Sub  
   If Len(sUsername) = 0 Then MsgBox "Не указана учетная запись", vbInformation, "www.Excel-VBA.ru": Exit Sub  
   If Len(sPass) = 0 Then MsgBox "Не указан пароль", vbInformation, "www.Excel-VBA.ru": Exit Sub  
 
   sTo = [B2] 'Кому
   sFrom = [B3] 'От кого
   sSubject = [B4] 'Тема письма
   sBody = [B5] 'Текст письма
   'sAttachment = [B6] 'Вложение(полный путь к файлу)
   sAttachment = Cells(6, "B").Value  
   'Проверка наличия файла по указанному пути  
   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  
       '.AddAttachment = sAttachment  
       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, "Проверка доступа в Интернет"  
   Set oCDOMsg = Nothing: Set oCDOCnf = Nothing  
End Sub

Спасибо.  
Очень хотелось еще книгу Мошер почитать:)