LEADERSOFT.ru Разработка на заказ программ и сайтов
Раздел обучения информационным технологиям
Разработка программ на Access
01. Этот пример (1) позволяет вам отправить электронное сообщение из Access через Outlook. Для работы программы в новых файлах создайте ссылку на Outlook в VBA: C:\Program Files\Microsoft Office\OFFICE11\MSOUTL.OLB
Свойства продукта

 Источник: Перейти

   

'==============================================================
'  Назначение
'    "Послать почту из базы данных"
Private Sub butExecute_Click()
Dim app As Outlook.Application  'Приложение программы
Dim dbs As Database 'База данных
Dim rst As Recordset 'Источник email
Dim As Integer 'Счетчик
Dim itm As MailItem 'Почтовое сообщение
Dim myFile As String 'Присоединяемый файл

    On Error GoTo 999
    Set dbs = CurrentDb 'Выбор базы данных
    Me.Refresh 'Сохраняем данные
    myFile = Application.CurrentProject.Path & "\" & Me.Attachment
    myFile = Dir(myFile)
    'Открываем таблицу c почтовыми адресами
    Set rst = dbs.OpenRecordset("SELECT * FROM [Пример 01email] WHERE ([Вкл]=True);")
    If rst.RecordCount <> 0 Then 'Проверяем записи
        rst.MoveLast 'Заполняем запрос
        rst.MoveFirst 'Первая запись
        Set app = New Outlook.Application 'Новое сообщение
        Dim myNamespace, myfolder As MAPIFolder, mynewfolder
        Set myNamespace = app.GetNamespace("MAPI")
        Set myfolder = myNamespace.GetDefaultFolder(olFolderInbox)
        'Set myfolder = _
        '    app.ActiveExplorer.CurrentFolder.Folders

        Set mynewfolder = myfolder.Folders.Add("My Contacts")
        
        Set itm = app.CreateItem(olMailItem) 'Добавляем письмо
        itm.Subject = Me.Subject  'Тема письма
        itm.Body = Me.Body 'Текст письма
        If myFile <> "" Then itm.Attachments.Add myFile 'Прикрепляем файл
        For i = 0 To rst.RecordCount - 1 'Просматриваем адреса
            If rst!Вкл = True Then _
                itm.Recipients.Add rst!Email 'Добавляем новый адрес
            rst.MoveNext 'Следующий адрес
        Next
        itm.Send 'Отсылаем письмо
        app.Quit 'Закрываем Outlook
        MsgBox "Письмо успешно отправлено!", vbExclamation, "Почта"
    End If
    rst.Close 'Закрываем запрос
    Exit Sub
999:
    MsgBox Err.Description  'Ошибка
    Err.Clear
    app.Quit
End Sub

Copyright © 2002-2015 ООО Лидер Эксэсс
Сайт работает под управлением: ASP.NET, Access