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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 01.10.2017, 15:19   #11
Margenal
Пользователь
 
Регистрация: 20.08.2017
Сообщений: 13
По умолчанию

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
Call встреча. Без ()
Правильно ли я понимаю что Call нужно писать вместо sub?

но в таком случае при запуске макроса, отсутствует выбор имени самого макроса

можете на примере показать как правильно написать.

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

Цитата:
Сообщение от Margenal Посмотреть сообщение
Правильно ли я понимаю что Call нужно писать вместо sub?
нет. Надо писать
Код:
Call встреча
вместо
Код:
Call встреча()
Module2
Код:
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
ModuleCurrent
Код:
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 Встреча()
  Dim conn As ADODB.Connection
  Set conn = CreateObject("ADODB.Connection")
  dim acc as string 'ID почтовой сессии

    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
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 01.10.2017, 18:02   #13
Margenal
Пользователь
 
Регистрация: 20.08.2017
Сообщений: 13
По умолчанию

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
ModuleCurrent
Сделал как указано но теперь при запуске макроса выскакивает ошибка:

Run-time error '438':Object doesn't support this property or method.

И еще вопрос в References нужно ли подключать библиотеки?

Сейчас у меня дополнительно подключена библиотека:

Microsoft Activex Data Objects 2.8 Library

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

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

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
Раз работаете с аксесом то референс аксеса очень рекомендую ��
в данном случае это что за ссылка?
Margenal вне форума Ответить с цитированием
Старый 02.10.2017, 11:49   #16
Margenal
Пользователь
 
Регистрация: 20.08.2017
Сообщений: 13
По умолчанию

Цитата:
Сообщение от Aleksandr H Посмотреть сообщение
Сделал как указано но теперь при запуске макроса выскакивает ошибка:

Run-time error '438':Object doesn't support this property or method.
Можете подсказать по поводу ошибки
Margenal вне форума Ответить с цитированием
Старый 02.10.2017, 12:01   #17
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

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

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
Я не знаю где именно по коду она вываливается
От ошибки избавился путем удаления всего кода и заново его прописал как новый макрос.
но теперь появилась новая ошибка
Compile error: User-defined type not defined
при этом выделяет строку : conn As ADODB.Connection
Изображения
Тип файла: png 2017-10-02_14-54-59.png (3.3 Кб, 38 просмотров)
Margenal вне форума Ответить с цитированием
Старый 02.10.2017, 16:30   #19
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

https://stackoverflow.com/questions/...es-not-defined
Код:
dim conn as object
Цитата:

I had forgotten to add a reference to "Microsoft ActiveX Data Objects 2.5 Library":

Tools > References > Check the checkbox in front of "Microsoft ActiveX Data Objects 2.5 Library"
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
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