Триггер для запуска макроса перспективы

Question

Есть ли способ, которым Outlook автоматически запускает макрос всякий раз, когда я получаю письмо, которое отправляется в определенную папку в Outlook (просто для уточнения, письмо идет туда, потому что я настроил правило, поэтому вместо этого перехода к моему почтовому ящику идет в эту папку).

Мне кажется, мне нужен код, который обнаруживает, когда моя папка получает новое электронное письмо, а затем автоматически запускает макрос.

Мой код заключается в следующем, я выполнить тест, который выполняет SaveEmailAttachmentsToFolder.

Sub Test() 

'Arg 1 = Folder name of folder inside your Inbox 'Arg 2 = File extension, "" is every file 'Arg 3 = Save folder, "C:\Users\Ron\test" or "" ' If you use "" it will create a date/time stamped folder for you in your "Documents" folder ' Note: If you use this "C:\Users\Ron\test" the folder must exist. 

SaveEmailAttachmentsToFolder "Dependencia Financiera", "xls", "V:\Dependencia Financiera\Dependencia Financiera\" 

End Sub 

Sub SaveEmailAttachmentsToFolder(OutlookFolderInInbox As String, _ ExtString As String, DestFolder As String) 

Dim ns As NameSpace 
Dim Inbox As Folder 
Dim SubFolder As Folder 

Dim subFolderItems As Items 

Dim Atmt As Attachment 

Dim FileName As String 

Set ns = GetNamespace("MAPI") 
Set Inbox = ns.GetDefaultFolder(olFolderInbox) 
Set SubFolder = Inbox.Folders(OutlookFolderInInbox) 

Set subFolderItems = SubFolder.Items 

If subFolderItems.Count > 0 Then 

    subFolderItems.Sort "[ReceivedTime]", True 

    For Each Atmt In subFolderItems(1).Attachments 
     If LCase(Right(Atmt.FileName, Len(ExtString))) = LCase(ExtString) Then 
      FileName = DestFolder & Atmt.FileName 
      Atmt.SaveAsFile FileName 
     End If 
    Next Atmt 

End If 

' Clear memory ThisMacro_exit: 
Set SubFolder = Nothing 
Set Inbox = Nothing 
Set ns = Nothing 
Set subFolderItems = Nothing 

End Sub 

seulberg1 сказал мне, чтобы использовать follwing код, как, должно моя паста мой собственный код, так как он имеет 2 Subs.

Private WithEvents Items As Outlook.Items 

Private Sub Application_Startup() Dim olApp As Outlook.Application 

Set olApp = Outlook.Application Set Items = GetNS(olApp).GetDefaultFolder(olFolderInbox).Folders("YourFolderName").Items End Sub 

Private Sub Items_ItemAdd(ByVal item As Object) 

On Error GoTo ErrorHandler 

'Add your code here 

ProgramExit: Exit Sub ErrorHandler: MsgBox Err.Number & " - " & Err.Description Resume ProgramExit End Sub 

Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace Set GetNS = app.GetNamespace("MAPI") End Function 

Спасибо вам заранее!

Answer 1

Этот код (адаптированный от Jimmy Pena) должен сделать трюк.

Он инициирует прослушиватель событий при запуске Outlook и проверяет папку «Имя вашей папки» для новых писем. Затем он выполняет назначенное действие в разделе («Добавить свой код здесь»).

Позвольте мне знать, если это помогает

С наилучшими пожеланиями seulberg1

Private WithEvents Items As Outlook.Items 

Private Sub Application_Startup() 
    Dim olApp As Outlook.Application 

    Set olApp = Outlook.Application 
    Set Items = GetNS(olApp).GetDefaultFolder(olFolderInbox).Folders("YourFolderName").Items 
End Sub 

Private Sub Items_ItemAdd(ByVal item As Object) 

    On Error GoTo ErrorHandler 

    **'Add your code here** 

ProgramExit: 
    Exit Sub 
ErrorHandler: 
    MsgBox Err.Number & " - " & Err.Description 
    Resume ProgramExit 
End Sub 

Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace 
    Set GetNS = app.GetNamespace("MAPI") 
End Function