Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Access
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 29.09.2017, 19:36   #1
Margenal
Пользователь
 
Регистрация: 20.08.2017
Сообщений: 13
По умолчанию Макрос в VBA Outlook для периодической записи непрочитанных сообщений в БД Access

Есть база данных на Access которая содержит следующие поля в указанных форматах:

DateReceipt : Дата/время
Mail_by : Текстовый
Mail_Addressee : Поле МЕМО
Mail_cc : Поле МЕМО
Mail_subject : Поле МЕМО
Mail_body : Поле МЕМО
Mail_file : Поле объекта OLE
Request_status : текстовый

Стоит задача, что бы посредством макроса VBA в Outlook, при срабатывании встречи через определенный отрезок времени (5 минут) происходила проверка на наличие непрочитанных сообщений и если таковые находятся то происходила их сохранение (запись) в БД Access. В следующем порядке: DateReceipt (Дата поступления), Mail_by (От кого), Mail_Addressee (Получатель), Mail_cc (Копия), Mail_subject (Тема письма), Mail_body (содержание письма), Mail_file (вложение) Request_status(статус запроса "Новый запрос")

И после сохранения происходила отметка писем прочитанными.

пытаюсь применить следующий код:

Код:
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  Dim conn As ADODB.Connection
  Set conn = CreateObject("ADODB.Connection")
  dim acc as string 'ID почтовой сессии
 
Private Sub Application_Reminder(ByVal Item As Object) 'Событие "Напоминание"
    Dim apti As AppointmentItem 'Присваивание переменной события
    Dim subj As String 'Объявление переменной "тема"
    If TypeName(Item) <> "AppointmentItem" Then Exit Sub 'Проверка типа события
    
        Set apti = Item
        call Встреча()
        subj = "Пора посмотреть почту"
        If apti.subject = subj Then 'Проверка темы события
        apti.Application.Reminders.Remove subj 'Удаление события
        With apti 'Создание нового события
            .Start = DateAdd("n", 2, Now)
            .End = DateAdd("n", 2, .Start)
            .ReminderSet = True
            .ReminderMinutesBeforeStart = 0
            .Save
        End With
    End If
    Set apti = Nothing
End Sub
 
sub Встреча()
    For i = 1 To Outlook.Session.Accounts.Count 'Поиск нужной почты
        If Outlook.Session.Accounts(i).CurrentUser.Address = "адрес проверяемой почты" Then
            acc = i
            Exit For
        End If
    Next
Set myFolder = Outlook.session.Accounts.Item(acc).DeliveryStore.GetDefaultFolder(olFolderInbox) 'Задаем проверяемую папку "входящие" необходимой сессии
Set mymyItem = myFolder.Items.GetLast 'Присваиваем письмо переменной
Set ObjFolder = Application.session.Accounts.Item(acc).GetDefaultFolder(olFolderInbox).Folders("Название папки, куда скидывать прочитанные письма")
Sleep (100) 'Заставляем макрос отдохнуть секунду, пока письмо прогрузится
    If TypeName(mymyItem) = "MailItem" and mymyItem.UnRead = True Then
        If mymyItem.Body <> "" Then
            With conn
                .Provider = "Microsoft.Jet.OLEDB.4.0"
                .ConnectionTimeout = 10
                .ConnectionString = "Data Source='Путь к базе\База встреч\Mail_bd.mdb'"
                .CommandTimeout = 60
            End With
            conn.Open ()
               conn.Execute "INSERT INTO ImportOutlook (DateReceipt, Mail_by, Mail_Addressee, Mail_cc, Mail_subject, Mail_body, Mail_file) VALUES ('" & mymyItem.CreationTime & "', '" & mymyItem.Mail_by & "' , '" & mymyItem.Mail_Addressee & "', '" & mymyItem.Mail_cc & "', '" & mymyItem.Mail_subject & "', '" & mymyItem.Mail_body & "', '" & mymyItem.Mail_file.Count & "', '" & mymyItem.Mail_file & "')" 
            conn.Close ()
 
                                If mymyItem.Mail_file.Count > 0 Then
                For Each att In mymyItem.Mail_file
                    With att
                        .SaveAsFile "Путь к папке\Вложения" & .DisplayName 'Путь, куда сохранять вложения. Для каждого письма должна быть своя папка.
                    End With
                Next
            End If
            mymyItem.UnRead = False 'Отмечаем письмо прочтенным
            mymyItem.Move (ObjFolder) 'Перемещаем письмо в папку на почте
        End If
    End If
 
End Sub
Cейчас пробую сделать что бы сохраняло в папку, но в идеале хотелось бы чтобы вложения сохранялись в Access.

но столкнулся с такой проблемой

при применении макроса он кидает меня на строку Set conn = CreateObject("ADODB.Connection")

и выделяет красным цветом строки

conn.open() и conn.close()

помогите написать данный макрос с сохранением вложений в Access, вслучае если сохранение в вложений в Access не ивозможно реализовать то тогда подойдет в сохранение в папку. При этом в БД Access должен записаться путь к вложению
Margenal вне форума Ответить с цитированием
Старый 29.09.2017, 21:44   #2
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

А что будет если строку set Conn... Перенести перед строкой with Conn?
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 30.09.2017, 18:35   #3
Margenal
Пользователь
 
Регистрация: 20.08.2017
Сообщений: 13
По умолчанию

В таком случае вы
Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
А что будет если строку set Conn... Перенести перед строкой with Conn?
В таком случае выпадает ошибка:

Constants, fixed-length strings, arrays, user-defined types and Declare statements not allowed as Public members of object modules
Margenal вне форума Ответить с цитированием
Старый 30.09.2017, 18:57   #4
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Чем объясняется глобализация этих строк?
Код:
Dim conn As ADODB.Connection
  Set conn = CreateObject("ADODB.Connection")
  dim acc as string 'ID почтовой сессии
Попытка о5: Пропишите эти строки после
Код:
sub Встреча()
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 30.09.2017, 20:24   #5
Margenal
Пользователь
 
Регистрация: 20.08.2017
Сообщений: 13
По умолчанию

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
Чем объясняется глобализация этих строк?
Код:
Dim conn As ADODB.Connection
Set conn = CreateObject("ADODB.Connection")
dim acc as string
Строки прописаны т. к далее в sub Встреча происходит подключение к БД

Цитата:
Попытка о5: Пропишите эти строки после
Код:
sub Встреча()
Если я пытаюсь прописать данные строки после sub Встреча()

то выдает ошибку:

Constants, fixed-length strings, arrays, user-defined types and Declare statements not allowed as Public members of object modules

подскажите как можно сделать данный макрос рабочим

Последний раз редактировалось Margenal; 30.09.2017 в 20:26.
Margenal вне форума Ответить с цитированием
Старый 30.09.2017, 21:50   #6
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

ето
Код:
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
в отдельный модуль запихните.
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 01.10.2017, 10:27   #7
Margenal
Пользователь
 
Регистрация: 20.08.2017
Сообщений: 13
По умолчанию

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
в отдельный модуль запихните.
Подскажите правильно ли я понимаю, что нужно создать Module1 и вставить туда данную строку?

и достаточно вставить только первую строку или необходимо в модуль вставить все строки, т.е
Код:
Public Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
  Dim conn As ADODB.Connection
  Set conn = CreateObject("ADODB.Connection")
  Dim acc As String

Последний раз редактировалось Margenal; 01.10.2017 в 11:57.
Margenal вне форума Ответить с цитированием
Старый 01.10.2017, 12:01   #8
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Первую строку в отдельный модуль. Вторую-четвертую после sub Встреча. Я бы так писал
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 01.10.2017, 12:42   #9
Margenal
Пользователь
 
Регистрация: 20.08.2017
Сообщений: 13
По умолчанию

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
Первую строку в отдельный модуль. Вторую-четвертую после sub Встреча. Я бы так писал
попробовал как вы сказали но теперь при запуске макроса, выскакивает следуещее
Argument not optional

при этом подсвечивает sub Встреча
Изображения
Тип файла: png 2017-10-01_12-43-05.png (3.3 Кб, 57 просмотров)
Margenal вне форума Ответить с цитированием
Старый 01.10.2017, 14:49   #10
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Call встреча. Без ()
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Макрос в VBA, что бы Outlook периодически самостоятельно новые поступающие письма сохранял в БД Access Aleksey_25 Microsoft Office Access 5 24.09.2017 14:33
макрос для Outlook для переадресации писем Olya1985 Microsoft Office Excel 1 13.09.2011 16:50
Макрос для Outlook kotmotroskin Microsoft Office Excel 0 02.02.2011 13:16
VBA outlook обработка входящих сообщений Drek Помощь студентам 2 18.07.2010 04:19
Макрос для сохранения писем из Outlook. GoreProgrammist Microsoft Office Excel 1 16.11.2009 19:40