Предлагаемое решение основывается на использование программы blat.exe, способной отправлять письмо с параметрами, получаемыми через командную строку. Данный метод позволяет рассылать почту, не трогая многострадальное registry на Вашем компьютере.
Процедура Email() рассылает письма, параметры которых указаны в записях таблицы eLetters:
|
Имя поля |
Тип данных |
Описание |
|
eLetterID |
Счетчик |
|
|
Recipient |
Текстовый |
Адрес получателя |
|
CopyTO |
Текстовый |
Адрес для отсылки копии |
|
Subject |
Текстовый |
Тема письма |
|
Body |
Поле MEMO |
Текст письма |
|
AttachedFileName |
Текстовый |
Полное имя присоединенного файла |
Для того, чтобы иметь возможность делать рассылки, Вы должны настроить работу программы blat.exe. Для этого скачайте blat.zip (уникальная копия, между прочим! Я связался с одним из авторов - Tim Charron. Он сжалился надо мной и специально для меня перекомпилил программу, дабы она отсылала письма в кодировке KOI8R) и распакуйте его в любой каталог на Вашем диске. Путь к каталогу, в котором находится программа blat.exe, сделайте значением константы PathToBlat и пропишите в параметре PATH файла autoexec.bat.
Если у Вас связь с Интернет по модему - установите флажок "Подключаться автоматически" в свойствах броузера.
Теперь Вы готовы рассылать письма. Ниже - модуль, позволяющий это осуществлять.
Option Compare Database
Option Explicit
'Данный модуль рассылает письма, выбирая содержание и реквизиты письма из таблицы eLetters
'Основная процедура - Email() Она формирует файл sendmail.bat и при подтверждении пользователя запускает его
'(с) 2001 Максименко Юрий
'Константы, конфигурирующие программу blat.exe
Public Const PathToBlat As String = "C:Blat"
Public Const PathToEmailFile As String = "C:mail"
Public Const ServerName As String = " ИмяПочтовогоСервера "
Public Const UserName As String = " Логин "
'Таблицы кодировок
Public Const S_WIN = "АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЬЫЪЭЮЯабвгдеёжзийклмнопрстуфхцчшщьыъэюя"
Public Const S_KOI8R = "бвчздеiцъйклмнопртуфхжигюыэшщяьасБВЧЗДЕЈЦЪЙКЛМНОПРТУФХЖИГЮЫЭШЩЯЬАС"
Public Const S_DOS866 = "ЂЃ‚ѓ"…р†‡?‰Љ"ЊЌЋЏђ""""•--�™њ"љќћџ ЎўЈ¤Ґс¦§Ё©Є"¬®Їабвгдежзиймлкноп"
Public Const S_ISO88595 = "°±ІіґµЎ¶·ё№є"јЅѕїАБВГДЕЖЗИЙМЛКНОПРСТУФХсЦЧШЩЪЫЬЭЮЯабвгдежзиймлкноп"
'Процерура рассылки писем из таблицы. Главная процедура модуля
Sub Email()
Dim rst As DAO.Recordset
Dim n As Long
Dim strToFile, FileName As String
'Убиваем старый командный файлы
On Error Resume Next
Kill (PathToBlat & "sendmail.bat")
Kill PathToEmailFile & "Body*.txt"
On Error Goto 0
'Создаем bat-файл
n = FreeFile
FileName = PathToBlat & "sendmail.bat"
n = FreeFile
Open FileName For Output As #n
strToFile = "blat.exe -install " & ServerName & " " & UserName & vbCrLf
Print #n, , strToFile
Set rst = CurrentDb.OpenRecordset("SELECT eLetterID FROM eLetters")
If Not rst.EOF Then
rst.MoveLast
rst.MoveFirst
End If
Do While Not rst.EOF
strToFile = StringForBat(rst!eLetterID) 'Строка для одного письма
Print #n, , strToFile
rst.MoveNext
Loop
rst.Close
Close #n
If MsgBox("bat-файл для отсылки писем создан. Толкнуть его на выполнение?", vbQuestion + vbYesNo + vbDefaultButton2, "А это кому-нибудь нужно?") = vbYes Then Call Shell(FileName, vbHide)
End Sub
Function StringForBat(ByVal eLetterID As Long) As String
'Создается командный файл и запускается
Dim Recipient, Subject, body, CopyTO, AttachedFileName, FileName, strToFile As String
Dim rst As DAO.Recordset
Dim n As Long
'Выясним параметры письма
Set rst = CurrentDb.OpenRecordset("SELECT * FROM eLetters WHERE eLetterID=" & eLetterID)
Recipient = rst!Recipient
CopyTO = rst!CopyTO
Subject = rst!Subject
body = CODE_TO_CODE(rst!body)
AttachedFileName = rst!AttachedFileName
rst.Close
'Создаем txt-файл для тела сообщения
n = FreeFile
FileName=PathToEmailFile & "Body" & EletterID & ".txt"
Open FileName For Output As #n
Print #n, Spc(0), Trim(body)
Close #n
StringForBat = "blat.exe " & chr(34) & FileName & chr(34) & " -t " & Recipient
If Not (CopyTO = "") Then StringForBat = StringForBat & " -c " & CopyTO
If Not (Subject = "") Then
Subject = CODE_TO_CODE(Subject)
StringForBat = StringForBat & " -s " & Chr(34) & CODE_TO_CODE(Subject, , S_DOS866) & Chr(34)
End If
If Not (AttachedFileName = "") Then StringForBat = StringForBat & " -attach " & chr(34) & AttachedFileName & chr(34)
StringForBat = StringForBat & " -mime"
End Function
'функция перекодировки
'(c) Владимир Лаврушкин
Public Function CODE_TO_CODE(ByVal Ustr As String, Optional S_Input = S_WIN, Optional S_OutPut = S_KOI8R) As String
Dim i, k As Integer
CODE_TO_CODE = ""
For i = 1 To Len(Ustr)
k = InStr(1, S_Input, Mid(Ustr, i, 1), vbBinaryCompare)
If k > 0 Then
CODE_TO_CODE = CODE_TO_CODE & Mid(S_OutPut, k, 1)
Else
CODE_TO_CODE = CODE_TO_CODE & Mid(Ustr, i, 1)
End If
Next i
End Function