1
votes

is there a way Outlook automatically runs a macro whenever I get an email that goes to a specific folder in Outlook (just to clarify, the email goes there because I have set up a rule, so instead of going to my inbox it goes to that folder).

I think I would need code that detects whenever my folder receives an new email and then automatically runs the macro.

My code is the following, I execute test, which executes 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 told me to use the follwing code how, should my paste my own code since, it has 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

Thanks you in advance !!!

1

1 Answers

0
votes

This code (adapted from Jimmy Pena) should do the trick.

It initiates the event listener on Outlook startup and checks the folder "Your Folder Name" for new emails. It then performs a designatable action at the ("Add your code here") section.

Let me know if this helps

Best regards 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