Здравствуйте.  
Нашел в инете макрос для отправки почты без помощи сторонних программ. Приспособил его под себя, заддав возможность аттачить к письму текущую книгу Excel.  
Не могу реализовать такую штуку. Хотелось бы для самоконтроля добавить в этот макрос задание писать в текстовый документ (txt) созданный в папке с отправляемыми отчетами строку типа "Файл такой-то (имя файла) успешно отправлен такого-то числа"    
И еще файлы у меня аттачатся почему-то с двойным расширением 06.12.2010.xls.xls. Как это исправить?    
 
 
Sub SendMail()    ' Отправка отчета по почте  
   txt = "Здравствуйте, Ольга!" & vbNewLine & _  
         "" & vbNewLine & _  
         "" & vbNewLine & _  
         "---------------------------" & vbNewLine & _  
         "С уважением Евгений"  
           
   If Send_Mail("xxx@gmail.com", "yyy@gmail.com", "Отчет СКД", txt) Then  
       MsgBox "Письмо успешно отправлено", vbInformation  
   Else  
       MsgBox "Не удалось отправить письмо", vbExclamation  
   End If  
 
End Sub  
 
Function Send_Mail(ByVal MailTo As String, ByVal MailFrom As String, _  
                  ByVal MailSubject As String, ByVal MailText As String, _  
                  Optional ByVal MailAttachment As String = "") As Boolean  
   ' функция для отправки почты без использования внешних почтовых программ  
   ' ----------------------------------------------------------------------  
   ' в качестве параметров получает:  
   ' MailTo - адрес получателя письма  
   ' MailFrom - адрес отправителя письма  
   ' MailSubject - тема письма  
   ' MailText - текст письма  
   ' MailAttachment - полный путь к файлу вложения (необязательный параметр)  
   ' ----------------------------------------------------------------------  
   ' возвращает TRUE, если отправка почты произошла успешно, и FALSE в обратном случае  
 
   Dim TempFilePath As String  
   TempFilePath = "C:\Windows\Temp\" & ActiveWorkbook.Name & ".xls"  
   ActiveWorkbook.SaveCopyAs (TempFilePath)  
     
   Const cdoConfigURL = "http://schemas.microsoft.com/cdo/configuration/"  
   On Error Resume Next: Err.Clear  
   
   smtpserver = GetSetting(Application.Name, "mail", "smtpserver", "")  
   sendusername = GetSetting(Application.Name, "mail", "sendusername", "")  
   sendpassword = GetSetting(Application.Name, "mail", "sendpassword", "")  
   If Len(smtpserver) = 0 Or Len(sendusername) = 0 Or Len(sendpassword) = 0 Then Exit Function  
   
   Set cdoConfig = CreateObject("CDO.Configuration")  
   With cdoConfig.Fields  
       .Item(cdoConfigURL & "sendusing") = 2  
       .Item(cdoConfigURL & "smtpauthenticate") = 1  
       .Item(cdoConfigURL & "smtpserver") = smtpserver  
       .Item(cdoConfigURL & "sendusername") = sendusername  
       .Item(cdoConfigURL & "sendpassword") = sendpassword  
       .Update  
   End With  
   
   Set cdoMessage = CreateObject("CDO.Message")  
   With cdoMessage  
       Set .Configuration = cdoConfig  
       .BodyPart.Charset = "koi8-r"  
       .From = MailFrom:  
       .To = MailTo  
       .Subject = MailSubject  
       .TextBody = MailText  
       .AddAttachment TempFilePath  
       .Send  
   End With  
   Set cdoMessage = Nothing: Set cdoConfig = Nothing  
'Check that file exists  
If Len(Dir$(TempFilePath)) > 0 Then  
   'First remove readonly attribute, if set  
   SetAttr TempFilePath, vbNormal  
   'Then delete the file  
    Kill TempFilePath  
End If  
   
   '    If Err.Number = -2147220973 Then MsgBox ("Отсутствует связь с интернетом")  
   '    If Err.Number = -2147220975 Then MsgBox ("SMTP сервер ответил отказом")  
   '    If Err.Number = 0 Then MsgBox ("Письмо отправлено")  
   Send_Mail = Err = 0  
End Function