Рассылка электронной почты из MS Access

Предлагаемое решение основывается на использование программы 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


Опубликовал admin
30 Окт, Суббота 2004г.



Программирование для чайников.