Solved: Error with autosave e-mail attachments macro

[heysus jamal]

Hi all,

This code below was designed to monitor subfolders in my inbox and save any excel attachments that came into the folders. It worked flawlessly in Office 2007 and Windows XP - however recently my company upgraded to Windows 7 and Office 2010. Since then the macro no longers works. Every time I boot up Outlook I receive the following VBA error message...



Run-time error '-2147221233 (8004010f)':

The attempted operation failed. An object could not be found.

When I select debug it leads me to the first instance where it is setting a target folder (BankofAmerica). The folder CLEARLY exists in my Outlook inbox as you can see in the picture below. I cannot for the life of me figure out why it no longer works. This is extremely important to me as these attachments are used by everyone else in the entire company. They come in overnight and need to be autosaved into the shared drive so people in our overseas group can view them.

http://i1302.photobucket.com/albums/ag139/cham_pion1/Inboxphoto_zps827482ba.jpg

'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 'GroupIncBankofAmerica Folder
Dim WithEvents TargetFolderItems2 As Items 'GroupIncBarclays Folder
Dim WithEvents TargetFolderItems3 As Items 'BankBarclays Folder
Dim WithEvents TargetFolderItems4 As Items 'GroupIncCitibank Folder
Dim WithEvents TargetFolderItems5 As Items 'BankCitibank Folder
Dim WithEvents TargetFolderItems6 As Items 'GroupIncDeutscheBank Folder
Dim WithEvents TargetFolderItems7 As Items 'BankDeutscheBank Folder
Dim WithEvents TargetFolderItems8 As Items 'GroupIncMorganStanley Folder
Dim WithEvents TargetFolderItems9 As Items 'GroupIncUBS Folder
Dim WithEvents TargetFolderItems10 As Items 'BankUBS Folder
'ESTABLISHES THE FILE DIRECTORY PATH THAT ATTACHMENTS WILL BE SAVED TO
Const FILE_PATH As String = "\\crplivfp01\Treasury (file://\\crplivfp01\Treasury) Shared\Automation\ValuationStatements\"

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("BankofAmerica").Items
Set TargetFolderItems2 = ns.Folders.item("Mailbox - Treasury Risk Management").Folders.item("ValuationStatements").Folders.item("Barclays").Items
Set TargetFolderItems3 = ns.Folders.item("Mailbox - Treasury Risk Management").Folders.item("ValuationStatements").Folders.item("Barclays_Bank").Items
Set TargetFolderItems4 = ns.Folders.item("Mailbox - Treasury Risk Management").Folders.item("ValuationStatements").Folders.item("Citibank").Items
Set TargetFolderItems5 = ns.Folders.item("Mailbox - Treasury Risk Management").Folders.item("ValuationStatements").Folders.item("Citibank_Bank").Items
Set TargetFolderItems6 = ns.Folders.item("Mailbox - Treasury Risk Management").Folders.item("ValuationStatements").Folders.item("DeutscheBank").Items
Set TargetFolderItems7 = ns.Folders.item("Mailbox - Treasury Risk Management").Folders.item("ValuationStatements").Folders.item("DeutscheBank_Bank").Items
Set TargetFolderItems8 = ns.Folders.item("Mailbox - Treasury Risk Management").Folders.item("ValuationStatements").Folders.item("MorganStanley").Items
Set TargetFolderItems9 = ns.Folders.item("Mailbox - Treasury Risk Management").Folders.item("ValuationStatements").Folders.item("UBS").Items
Set TargetFolderItems10 = ns.Folders.item("Mailbox - Treasury Risk Management").Folders.item("ValuationStatements").Folders.item("UBS_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 & "GroupIncBankofAmerica_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 UBS 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 & "GroupIncBarclays_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 UBS 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 & "BankBarclays_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 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 & "GroupIncCitibank_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 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 & "BankCitibank_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 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 & "GroupIncDeutscheBank_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 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)
'SAVE THE ATTACHMENT IF IT IS A MICROSOFT EXCEL BASED FILE
If UCase(Right(olAtt.FileName, 3)) = "CSV" Then
olAtt.SaveAsFile FILE_PATH & "BankDeutscheBank_Valuation_Statement.csv"
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 TargetFolderItems8_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 & "GroupIncMorganStanley_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_BANK FOLDER
Sub TargetFolderItems9_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)) = "XLS" Then
olAtt.SaveAsFile FILE_PATH & "GroupIncUBS_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_BANK FOLDER
Sub TargetFolderItems10_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)) = "XLS" Then
olAtt.SaveAsFile FILE_PATH & "BankUBS_Valuation_Statement.xls"
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 TargetFolderItems8 = Nothing
Set TargetFolderItems9 = Nothing
Set TargetFolderItems10 = Nothing
Set ns = Nothing

End Sub

[skatonni]

I am guessing from the picture that "Mailbox - Treasury Risk Management" should be "Treasury Risk Management".

[heysus jamal]

I am guessing from the picture that "Mailbox - Treasury Risk Management" should be "Treasury Risk Management".

:banghead:

Wow.... I guess it pays to have a second set of eyes look at your work. In Outlook 2003 it was necessary to have the "Mailbox" in front of the actual mailbox name. I guess that was no longer necessary in Office 2010. Thanks for the sharp eye! Problem solved. Anyone know how I can change this to Solved?

[heysus jamal]

For anyone looking for code to automatically save attachments from incoming e-mails to your local/network drive this is the code you are looking for! Tested on Windows 7 and Office 2010.