PDA

View Full Version : How to automatically run an Excel Macro after several e-mails have been received



heysus jamal
08-15-2012, 12:29 PM
Hi all,

I receive several e-mails everyday with attachments that are auto-saved to a location with the VBA code I have below. Is it possible to get the macro to also run a macro I have in an excel file only AFTER all of the e-mails (and attachments) have been received? Furthermore, can I have Outlook send me an e-mail after ALL of the files have been received? If I am not being clear please let me know and I will explain further. Thanks in advanced for your help!

'THIS MACRO MONITORS THE VALUATIONSTATEMENTS SUBFOLDERS AND SAVES THE ATTACHMENTS IN THE AUTOMATION FOLDER

Option Explicit

'THE TARGETFOLDERITEMS# IS A FOLDER THAT WILL BE ACTIVELY SCANNED FOR ACTIVITY
Dim WithEvents TargetFolderItems1 As Items 'UBS Folder
Dim WithEvents TargetFolderItems2 As Items 'DuetscheBank Folder
Dim WithEvents TargetFolderItems3 As Items 'Citibank Folder
Dim WithEvents TargetFolderItems4 As Items 'BankofAmerica Folder
Dim WithEvents TargetFolderItems5 As Items 'MorganStanley Folder
Dim WithEvents TargetFolderItems6 As Items 'Citibank_Bank Folder
Dim WithEvents TargetFolderItems7 As Items 'DeutscheBank_Bank Folder


'ESTABLISHES THE FILE DIRECTORY PATH THAT ATTACHMENTS WILL BE SAVED TO
Const FILE_PATH As String = "bla bla bla (http://www.vbaexpress.com/forum/)"
Private Sub application_startup()

Dim ns As Outlook.NameSpace
Set ns = Application.GetNamespace("MAPI")

Set TargetFolderItems1 = ns.Folders.item("Mailbox - Treasury Risk Management").Folders.item("ValuationStatements").Folders.item("UBS").Items
Set TargetFolderItems2 = ns.Folders.item("Mailbox - Treasury Risk Management").Folders.item("ValuationStatements").Folders.item("DeutscheBank").Items
Set TargetFolderItems3 = ns.Folders.item("Mailbox - Treasury Risk Management").Folders.item("ValuationStatements").Folders.item("Citibank").Items
Set TargetFolderItems4 = ns.Folders.item("Mailbox - Treasury Risk Management").Folders.item("ValuationStatements").Folders.item("BankofAmerica").Items
Set TargetFolderItems5 = ns.Folders.item("Mailbox - Treasury Risk Management").Folders.item("ValuationStatements").Folders.item("MorganStanley").Items
Set TargetFolderItems6 = ns.Folders.item("Mailbox - Treasury Risk Management").Folders.item("ValuationStatements").Folders.item("Citibank_Bank").Items
Set TargetFolderItems7 = ns.Folders.item("Mailbox - Treasury Risk Management").Folders.item("ValuationStatements").Folders.item("DeutscheBank_Bank").Items

End Sub
'THIS SUBROUTINE RUNS WHEN AN "EVENT" OCCURS - IN THIS CASE A NEW E-MAIL IS PLACED IN THE UBS FOLDER
Sub TargetFolderItems1_ItemAdd(ByVal item As Object)

'VARIABLE TYPES ARE DEFINED
Dim olAtt As Attachment
Dim i As Integer

'LOOKS FOR AN ATTACHMENT
If item.Attachments.Count > 0 Then
For i = 1 To item.Attachments.Count
Set olAtt = item.Attachments(i)

'SAVE THE ATTACHMENT IF IT IS A MICROSOFT EXCEL BASED FILE
If UCase(Right(olAtt.FileName, 3)) = "XLS" Then
olAtt.SaveAsFile FILE_PATH & "UBS_Valuation_Statement.xls"
End If

Next

End If

Set olAtt = Nothing

End Sub
'THIS SUBROUTINE RUNS WHEN AN "EVENT" OCCURS - IN THIS CASE A NEW E-MAIL IS PLACED IN THE DEUTSCHEBANK FOLDER
Sub TargetFolderItems2_ItemAdd(ByVal item As Object)

'VARIABLE TYPES ARE DEFINED
Dim olAtt As Attachment
Dim i As Integer

'LOOKS FOR AN ATTACHMENT
If item.Attachments.Count > 0 Then
For i = 1 To item.Attachments.Count
Set olAtt = item.Attachments(i)

'SAVE THE ATTACHMENT IF IT IS A MICROSOFT EXCEL BASED FILE
If UCase(Right(olAtt.FileName, 3)) = "XLS" Then
olAtt.SaveAsFile FILE_PATH & "DB_Valuation_Statement.xls"
End If

Next

End If

Set olAtt = Nothing

End Sub
'THIS SUBROUTINE RUNS WHEN AN "EVENT" OCCURS - IN THIS CASE A NEW E-MAIL IS PLACED IN THE CITIBANK FOLDER
Sub TargetFolderItems3_ItemAdd(ByVal item As Object)

'VARIABLE TYPES ARE DEFINED
Dim olAtt As Attachment
Dim i As Integer

'LOOKS FOR AN ATTACHMENT
If item.Attachments.Count > 0 Then
For i = 1 To item.Attachments.Count
Set olAtt = item.Attachments(i)

'SAVE THE ATTACHMENT IF IT IS A MICROSOFT EXCEL BASED FILE
If UCase(Right(olAtt.FileName, 3)) = "XLS" Then
olAtt.SaveAsFile FILE_PATH & "Citigroup_Valuation_Statement.xls"
End If

Next

End If

Set olAtt = Nothing

End Sub
'THIS SUBROUTINE RUNS WHEN AN "EVENT" OCCURS - IN THIS CASE A NEW E-MAIL IS PLACED IN THE BANKOFAMERICA FOLDER
Sub TargetFolderItems4_ItemAdd(ByVal item As Object)

'VARIABLE TYPES ARE DEFINED
Dim olAtt As Attachment
Dim i As Integer

'LOOKS FOR AN ATTACHMENT
If item.Attachments.Count > 0 Then
For i = 1 To item.Attachments.Count
Set olAtt = item.Attachments(i)

'SAVE THE ATTACHMENT IF IT IS A MICROSOFT EXCEL BASED FILE
If UCase(Right(olAtt.FileName, 3)) = "XLS" Then
olAtt.SaveAsFile FILE_PATH & "BofA_Valuation_Statement.xls"
End If

Next

End If

Set olAtt = Nothing

End Sub
'THIS SUBROUTINE RUNS WHEN AN "EVENT" OCCURS - IN THIS CASE A NEW E-MAIL IS PLACED IN THE MORGANSTANLEY FOLDER
Sub TargetFolderItems5_ItemAdd(ByVal item As Object)

'VARIABLE TYPES ARE DEFINED
Dim olAtt As Attachment
Dim i As Integer

'LOOKS FOR AN ATTACHMENT
If item.Attachments.Count > 0 Then
For i = 1 To item.Attachments.Count
Set olAtt = item.Attachments(i)

'SAVE THE ATTACHMENT IF IT IS A MICROSOFT EXCEL BASED FILE
If UCase(Right(olAtt.FileName, 3)) = "XLS" Then
olAtt.SaveAsFile FILE_PATH & "MS_Valuation_Statement.xls"
End If

Next

End If

Set olAtt = Nothing

End Sub
'THIS SUBROUTINE RUNS WHEN AN "EVENT" OCCURS - IN THIS CASE A NEW E-MAIL IS PLACED IN THE CITIBANK_BANK FOLDER
Sub TargetFolderItems6_ItemAdd(ByVal item As Object)

'VARIABLE TYPES ARE DEFINED
Dim olAtt As Attachment
Dim i As Integer

'LOOKS FOR AN ATTACHMENT
If item.Attachments.Count > 0 Then
For i = 1 To item.Attachments.Count
Set olAtt = item.Attachments(i)

'SAVE THE ATTACHMENT IF IT IS A MICROSOFT EXCEL BASED FILE
If UCase(Right(olAtt.FileName, 3)) = "XLS" Then
olAtt.SaveAsFile FILE_PATH & "Citigroup_Valuation_Statement_Bank.xls"
End If

Next

End If

Set olAtt = Nothing

End Sub

'THIS SUBROUTINE RUNS WHEN AN "EVENT" OCCURS - IN THIS CASE A NEW E-MAIL IS PLACED IN THE DEUTSCHEBANK_BANK FOLDER
Sub TargetFolderItems7_ItemAdd(ByVal item As Object)

'VARIABLE TYPES ARE DEFINED
Dim olAtt As Attachment
Dim i As Integer

'LOOKS FOR AN ATTACHMENT
If item.Attachments.Count > 0 Then
For i = 1 To item.Attachments.Count
Set olAtt = item.Attachments(i)

'OPEN THE ATTACHMENT - DELETE ERROR CAUSING MATERIAL
If UCase(Right(olAtt.FileName, 3)) = "CSV" Then
olAtt.SaveAsFile FILE_PATH & "DB_Valuation_Statement_Bank.csv"
End If

Next

End If

Set olAtt = Nothing

End Sub
Private Sub Application_Quit()

Dim ns As Outlook.NameSpace
Set TargetFolderItems1 = Nothing
Set TargetFolderItems2 = Nothing
Set TargetFolderItems3 = Nothing
Set TargetFolderItems4 = Nothing
Set TargetFolderItems5 = Nothing
Set TargetFolderItems6 = Nothing
Set TargetFolderItems7 = Nothing
Set ns = Nothing

End Sub

heysus jamal
08-15-2012, 06:07 PM
I think I know how to open Excel and execute a macro from Outlook - is what I have below correct?


'OPEN NEW EXCEL APPLICATION
Set XLApp = CreateObject("Excel.Application")
'OPEN EXCEL FILE AND RUN THE MACRO
On Error Resume Next 'DO I NEED THIS?
XLApp.Workbooks.Open ("C:\WHATEVER.XLSM")
On Error Goto 0 'DO I NEED THIS EITHER?
XLApp.Run ("WHATEVER.XLSM!MACRO_NAME")
XLApp.Workbooks.Close
XLApp.Quit

To give a little background, the seven files that I receive and save the attachments come in at different times during the course of the night. I feel like the code above would execute AS SOON as the first e-mail comes in no? I want it to run ONLY AFTER all of the e-mails have come in and the attachments have been saved on my shared drive.

Remember - the code I have in my first post works FLAWLESSLY, no issues with that part.

heysus jamal
08-15-2012, 08:22 PM
Sorry to quote myself, but I didn't know you could not edit your own posts. But I wanted to add to this to my second post... if I add the code below to the end of my code in the first one (which is in "ThisOutlookSession") will it work or fail?


I think I know how to open Excel and execute a macro from Outlook - is what I have below correct?


'OPEN NEW EXCEL APPLICATION
Set XLApp = CreateObject("Excel.Application")
'OPEN EXCEL FILE AND RUN THE MACRO
On Error Resume Next 'DO I NEED THIS?
XLApp.Workbooks.Open ("C:\WHATEVER.XLSM")
On Error Goto 0 'DO I NEED THIS EITHER?
XLApp.Run ("WHATEVER.XLSM!MACRO_NAME")
XLApp.Workbooks.Close
XLApp.Quit

To give a little background, the seven files that I receive and save the attachments come in at different times during the course of the night. I feel like the code above would execute AS SOON as the first e-mail comes in no? I want it to run ONLY AFTER all of the e-mails have come in and the attachments have been saved on my shared drive.

Remember - the code I have in my first post works FLAWLESSLY, no issues with that part.