Sub Формирование_и_Отправка_Писем()
Dim ro As Range, ra As Range: On Error Resume Next
If ПутьКФайлуПрограммыTheBAT = "" Then MsgBox "Программа TheBAT! не установлена!", _
vbCritical, "Отправка почты невозможна": Exit Sub

' таблица с заполненными ячейками в первом столбце
Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp))

For Each ro In ra.EntireRow ' перебираем все заполненные строки
Адрес = Trim$(ro.Cells(1))
If Адрес Like "*?@?*.?*" Then ' если в первой ячейке указан корректный адрес почты

' формируем текст письма
Текст = "Предоставленный документ: " & ro.Cells(3) & vbNewLine & vbNewLine
Текст = Текст & "Формат документа: " & ro.Cells(4) & " на " & ro.Cells(5) & " стр." & vbNewLine
Текст = Текст & "Срок выполнения: " & ro.Cells(6) & vbNewLine
'Текст = Текст & "Стоимость: " & ro.Cells(7) & " " & ro.Cells(8) & vbNewLine
'Текст = Текст & "Дата выполнения: " & ro.Cells(9) & vbNewLine

' формируем тему письма из 2-й ячейки строки
Тема = "Информация для " & ro.Cells(2) & " от Флиппост г.Чебоксары"

ОтправитьПисьмоЧерезTheBat Адрес, Текст, Тема
End If
Next ro
End Sub

Function ОтправитьПисьмоЧерезTheBat(ByVal Email As String, _
ByVal Текст As String, Optional ByVal Тема As String = "", _
Optional ByVal AttachFilename As String = "") As Boolean
' функция производит отправку письма с заданной темой и текстом на адрес Email
' с почтового ящика, настроенного в TheBAT для отправки писем "по-умолчанию"
' Если задан параметр AttachFilename, к отправляемому письму прикрепляется файл

strTO = "TO=" & Chr(34) & Email & Chr(34) ' адрес получателя (можно указать список адресов)
strSUBJECT = "SUBJECT=" & Chr(34) & Replace(Тема, """", "`") & Chr(34) ' тема сообщения

Filename$ = Environ("temp") & "\mail." & Fix(Rnd() * 1E+15)
ff = FreeFile: Open Filename$ For Output As #ff
Print #ff, Текст: Close #ff ' пишем текст в файл

' текст сообщения (или путь к текстовому файлу с сообщением)
strTEXT = "TEXT=" & Chr(34) & Filename$ & Chr(34) ' Chr(34) - это кавычка

' путь к прикреплённому файлу (можно прикрепить несколько файлов)
If AttachFilename <> "" Then strATTACH = "ATTACH =" & Chr(34) & AttachFilename & Chr(34)

TheBatPath = ПутьКФайлуПрограммыTheBAT: DoEvents
Cmd$ = Chr(34) & TheBatPath & Chr(34) & " /MAIL;" & strTO & ";" & strSUBJECT & ";" & _
strTEXT & ";" & strATTACH & " /SENDALL; /MINIMIZE;" ' формируем командную строку

CreateObject("WScript.Shell").Exec Cmd$ ' выполняем команду
End Function

Function Send_Mail_with_TheBAT_from_Excel_VBA()
' теперь и без этого всё работает <img rel="usm" src="http://www.excelworld.ru/sml2/smile.gif" border="0" align="absmiddle" alt=":)" /> видимо, раньше у меня была глючная версия TheBAT
For i = 1 To 30000: DoEvents: Next ' пауза - без неё почему-то не происходит отправки
Cmd2 = TheBatPath & " /SENDALL;": wsh.Exec Cmd2 ' команда ОТПРАВИТЬ ВСЮ ПОЧТУ
End Function

Function ПутьКФайлуПрограммыTheBAT() As String
' читает из реестра путь к исполняемому файлу программы TheBAT!
' возвращает путь к файлу, или пустую строку, если TheBAT! не установлен
On Error Resume Next: Err.Clear
Key$ = "HKEY_CURRENT_USER\Software\RIT\The Bat!\EXE path"
ПутьКФайлуПрограммыTheBAT = CreateObject("WScript.Shell").RegRead(Key$)
End Function

Function DefaultMailAccount() As String
' читает из реестра настройки почтового ящика,
' установленного в TheBAT! как "ящик по-умолчанию"
' возвращает адрес почты, или пустую строку, если TheBAT! не настроен
On Error Resume Next: Err.Clear
Key$ = "HKEY_CURRENT_USER\Software\RIT\The Bat!\Users depot\Default"
DefaultMailAccount = CreateObject("WScript.Shell").RegRead(Key$)
End Function

Sub УзнатьАдресПочты()
MsgBox DefaultMailAccount, vbInformation
End Sub