Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Курилка
Страницы: 1
RSS
VBA Outlook, Изменение существующего макроса - добавить автоматический запуск
 
#1
25.07.2024 08:57:23
Здравствуйте, уважаемые форумчане!
Есть макрос, который все элементы, попадающие в корзину, делает прочитанными.
Он начинает работать тогда, когда я его запускаю вручную.
А можно ли сделать так, чтобы он автоматически запускался вместе с запуском самого Outlook?
Код
Private
WithEvents DeletedItemsFolder As Outlook.Folder

Private
WithEvents DeletedItemsItems As Outlook.Items

Private Sub
Application_Startup()
    Dim outlookApp As Outlook.Application
    Set outlookApp = Outlook.Application
    ' Получаем папку "Корзина"
    Dim mailbox As Outlook.MAPIFolder
    Set mailbox =
outlookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems)
    Set DeletedItemsFolder = mailbox
    Set DeletedItemsItems =
DeletedItemsFolder.Items
End Sub

Private Sub
DeletedItemsItems_ItemAdd(ByVal Item As Object)
    On Error Resume Next
    ' Помечаем
добавленный элемент как прочитанный
    Item.UnRead =
False
    ' Очищаем память
    Set Item = Nothing
End Sub
Изменено: LeoNeon - 25.07.2024 08:58:31
 
 
 
#2
25.07.2024 09:14:10
Код
Private WithEvents DeletedItemsFolder As Outlook.Folder

Private WithEvents DeletedItemsItems As Outlook.Items

Private Sub Application_Startup()
    Dim outlookApp As Outlook.Application
    Set outlookApp = Outlook.Application
    ' Ïîëó÷àåì ïàïêó "Êîðçèíà"
    Dim mailbox As Outlook.MAPIFolder
    Set mailbox = outlookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems)
    Set DeletedItemsFolder = mailbox
    Set DeletedItemsItems = DeletedItemsFolder.Items
    
    Dim oItem As Object
    On Error Resume Next
    For Each oItem In DeletedItemsItems
        oItem.UnRead = False
    Next
    On Error GoTo 0
End Sub
Изменено: МатросНаЗебре - 25.07.2024 09:14:18
 
 
 
#3
25.07.2024 15:42:30
Цитата
LeoNeon написал:
А можно ли сделать так, чтобы он автоматически запускался вместе с запуском самого Outlook?
Добрый день!
Можно. Для этого код нужно поместить в Outlook в модуль ThisOutlookSession.
И код можно упростить:
Код
' Код должен быть в Outlook в модуле ThisOutlookSession
Option Explicit

Private WithEvents objItems As Outlook.Items

Private Sub Application_Startup()
  Set objItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems).Items
End Sub

Private Sub objItems_ItemAdd(ByVal Item As Object)
  Item.UnRead = False
  Set Item = Nothing
End Sub
 
 
 
Страницы: 1
Наверх