представляет собой автономный почтовый клиент (почтовый робот), позволяющий:
– извлекать вложения из входящей почты и раскладывать их по директориям в соответствии с правилами разбора почты (по протоколу POP3);
– сканировать директории на наличие файлов, формировать для них письма и отправлять их на указанные адреса в соответствиями с правилами подготовки почты (по протоколу SMTP);
– обрабатывать неограниченное количество потовых аккаунтов;
– запускать внешнее приложение (командный файл) после приема почты;
– вести архив и журнал извлеченных и отправленных вложений;
– проверять и отправлять почту с заданным интервалом.

Private Sub Workbook_Open()
Dim bstFileName As String
Dim MonthDay As Long
Dim CurDay As String
Dim CurMonth As String
Dim CurMonthLY As String
Dim E_C As String
Dim E_CC As String

E_C = _
    "tik@er.ru, eva@er.ru," _
    & "ov@er.ru, mkov@er.ru," _
    & "tin@er.ru"
        
E_CC = _
    "tik@er.ru, eva@er.ru," _
    & "ov@er.ru, mkov@er.ru," _
    & "tin@er.ru

    Call Logo
    Sheets("Data").Visible = True
    bdt_Dat = Date - 1
    bstFileName = "c:\postie\!send_day.bat"
    Open bstFileName For Output As #1
    Print #1, "Rem -----------  Daily_Report.xls  " & Date & " " & Time
    Print #1,
    Print #1, "echo ______________________________________________________________________ >>!send_message.log"
    Print #1, "echo  " & bdt_Dat & " è " & bdt_Dat & "  >>!send_message.log"
    Print #1, "date /t  >>!send_message.log"
    Print #1, "time /t  >>!send_message.log"
    Print #1,
    
    CurMonth = "[Logicdate].[All Logicdate].[" & Year(bdt_Dat) & "].[" & Month_To_Text(Month(bdt_Dat)) & "]"
    CurMonthLY = "[Logicdate].[All Logicdate].[" & Year(bdt_Dat - 365) & "].[" & Month_To_Text(Month(bdt_Dat)) & "]"
    
    Sheets("Daily-by-TM").Select
    
    Range("E9").Select
    GetDollar
    Range("G9").Select
    GetDollarOLD
    
    
    Sheets("Data").Select
    
    
    If Day(Date) = 2 Then Month_Change
    
    ActiveSheet.PivotTables("Act sales").PivotCache.Refresh
    ActiveSheet.PivotTables("Act check").PivotCache.Refresh
    ActiveSheet.PivotTables("plan sales").PivotCache.Refresh
    ActiveSheet.PivotTables("plan check").PivotCache.Refresh
    ActiveSheet.PivotTables("LY sales").PivotCache.Refresh
    ActiveSheet.PivotTables("LY check").PivotCache.Refresh
    
    Sheets("Daily-by-TM").Select
    
    Sort_Data
    
    With ActiveWorkbook.PublishObjects("MTD_Report_28372")
        .Filename = "d:\documents\Reports\" & bdt_Dat & "_Sales.mht"
        .Publish (False)
        .AutoRepublish = False
    End With
 
    
    Print #1, "postie.exe -config -a:" _
    & Chr(34) & "d:\documents\Reports\" & bdt_Dat & "_Sales.mht" & Chr(34) _
    & " -to:" & Chr(34) & E_C & Chr(34) _
    & " -cc:" & Chr(34) & E_CC & Chr(34) _
    & " -s:" & Chr(34) & "Every Day Report - Sales" & bdt_Dat & Chr(34) _
    & " -msg:" & Chr(34) & "Every Day Report - Sales " & bdt_Dat & Chr(34) _
    & " -file:" & Chr(34) & "text_typ.txt" & Chr(34) _
    & " >>!send_message.log"
 
    
    Close #1
    Sheets("Daily-by-TM").Select
    Sheets("Data").Visible = False
    ActiveWindow.Close SaveChanges:=True
  
End Sub

Dim oOutlook As New Outlook.Application
Dim oMessage As Outlook.MailItem
'Создаем объект сообщения
Set oMessage = oOutlook.CreateItem(olMailItem)
' Кому
oMessage.To = "Administrator@nwtraders.msft"
'Тема сообщения
oMessage.Subject = "Привет из VBA"
'Текст сообщения. Использование свойства Body означает, что мы посылаем сообщение
'обычным текстом. Можно также посылать сообщение в HTML или RTF
oMessage.Body = "Текст сообщения"
'Добавляем вложение
oMessage.Attachments.Add ("C:\installlog.txt")
'Отправляем сообщение
oMessage.Send

Sub test()
    Call SendPost("здесь IP почтового сервера или имя", "адрес получателя", "адрес отправителя", "Subj", "Тело", "атач" пример: C:\test.xls)
End Sub

'если не работает надо найти 2 библиотеки "inetcomm.dll msoert2.dll" и положить их в system32
Function SendPost(strSMTP_Server, strTo, strFrom, strSubject, strBody, strAttach)
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    Set Flds = iConf.Fields

    Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "пароль если есть"
    Flds.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") =  2 
    Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") =  10 
    Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTP_Server
    Flds.Update
    iMsg.Configuration = iConf

    iMsg.To = strTo
    iMsg.From = strFrom
    iMsg.Subject = strSubject
    iMsg.TextBody = strBody
    If strAttach <> "" Then iMsg.AddAttachment strAttach
    iMsg.Send
    Set iMsg = Nothing
    Set iConf = Nothing
    Set Flds = Nothing
End Function

 Flds.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") =  2 

Sub SendSheet(ws As Worksheet, Address As String, Subject As String)
    ActiveSheet.Copy
        ActiveWorkbook.SaveAs "Part of " & ThisWorkbook.Name & " " & Format(Now, "h-mm-ss"), xlWorkbookNormal
            ActiveWorkbook.SendMail Address, Subject
                ActiveWorkbook.ChangeFileAccess xlReadOnly
            Kill ActiveWorkbook.FullName
        ActiveWorkbook.Close False
End Sub

Sub DemoSendSheet()
    SendSheet ActiveSheet, "your_email@address", "test message"
End Sub