Макрос VBA Outlook на открытие книги Excel при получении входящего сообщения с определенной темой

RSS

Макрос VBA Outlook на открытие книги Excel при получении входящего сообщения с определенной темой, Запуск Excel при получении входящего сообщения Outlook по теме письма

ChubraevRO

Пользователь

Сообщений: 42 Регистрация: 10.03.2016

15.12.2022 14:18:45

Добрый день!
Пытаюсь наваять макрос в VBA Outlook, который по теме входящего сообщения будет запускать Excel и открывать книгу (и там запускать макрос)
из разных интернетов нарыл код, только чего-то не хватает - не срабатывает
и Application_NewMail, и Application_NewMailEx не работают - выдают ошибку на "if..."
понимаю, что надо положить в переменную Item это самое новое письмо, но не могу сообразить как..
помогите, пожалуйста!

Код

Private Sub Application_NewMail()
Dim Item As Outlook.MailItem ()
Dim xl As Object
       If Item.Subject = "Запуск макроса 1" Then
           Item.MarkComplete
            Set xl = CreateObject("Excel.Application")
            xl.Workbooks.Open ("C:\Users\Desktop\Работа\Макрос1.xlsm")
            xl.Run "'Макрос1.xlsm!'Test"
            xl.Quit
         Set xl = Nothing
       End If

End Sub

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim Item As Outlook.MailItem
Dim xl As Object
       If Item.Subject = "Запуск макроса 1" Then
           Item.MarkComplete
           Set xl = CreateObject("Excel.Application")
           xl.Workbooks.Open ("C:\Users\Users\Desktop\Работа\Макрос1.xlsm")
            xl.Run "'Макрос1.xlsm!'Test"
            xl.Quit
         Set xl = Nothing
       End If

End Sub

doober

Пользователь

Сообщений: 2380 Регистрация: 09.04.2013

15.12.2022 14:45:23

Добрый

Цитата
ChubraevRO написал: не работают - выдают ошибку на "if..."

Имеют право на это

Код

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim Item As Outlook.MailItem
Dim xl As Object
 Set Item = Application.GetNamespace("MAPI").GetItemFromID(EntryIDCollection)
       If Item.Subject = "Запуск макроса 1" Then
           Item.MarkComplete
           Set xl = CreateObject("Excel.Application")
           xl.Workbooks.Open ("C:\Users\Users\Desktop\Работа\Макрос1.xlsm")
            xl.Run "'Макрос1.xlsm!'Test"
            xl.Quit
         Set xl = Nothing
       End If
 
End Sub

Изменено: doober - 15.12.2022 14:45:45

ChubraevRO

Пользователь

Сообщений: 42 Регистрация: 10.03.2016

16.12.2022 11:40:10

Цитата

написал:
Добрый

Цитата
ChubraevRO написал: не работают - выдают ошибку на "if..."

Имеют право на это

Код

    [URL=#]?[/URL]       1  2  3  4  5  6  7  8  9  10  11  12  13  14      Private   Sub   Application_NewMailEx(  ByVal   EntryIDCollection   As   String  )    Dim   Item   As   Outlook.MailItem    Dim   xl   As   Object       Set   Item = Application.GetNamespace(  "MAPI"  ).GetItemFromID(EntryIDCollection)             If   Item.Subject =   "Запуск макроса 1"   Then                 Item.MarkComplete                 Set   xl = CreateObject(  "Excel.Application"  )                 xl.Workbooks.Open (  "C:\Users\Users\Desktop\Работа\Макрос1.xlsm"  )                  xl.Run   "'Макрос1.xlsm!'Test"                  xl.Quit               Set   xl =   Nothing             End   If          End   Sub

Спасибо!

Читают тему