Outlookマクロを実行するためのトリガー

Question

Outlookの特定のフォルダに移動する電子メールが届くと、Outlookは自動的にマクロを実行する方法です（ルールを設定しているため、私の受信箱に行くのはそのフォルダに行く）。

私は、自分のフォルダが新しい電子メールを受信したときにそれを検出し、自動的にマクロを実行するコードが必要だと思います。

私のコードは次のようである、私はそれが2回の潜水を持っている、以来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コードを使用するように私に言った実行テストを実行します。

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の起動時にイベントリスナーを開始し、新しいメールのフォルダ「Your Folder Name」をチェックします。次に、「ここにコードを追加」セクションで指定可能なアクションを実行します。

が、これは

敬具 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