Auto Save Attachments from multiple senders

[telepicker]

Hello All,

I have a cobbled together code that basically looks for an email from a specific sender with a specific subject line. Once that email is received then my code saves the attachment to the designated folder and the kicks off some macros in Access.

My problem/question is this.. How can I modify this code so that I can run the process on different different senders sending different attachments. This would all be excel attachments.

I would like to be able to specify a save to folder for each individual sender, but if I can not I could create a single Inbound Attachments folder.

Here is my code:


Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)


On Error GoTo ErrorHandler

'Only act if it's a MailItem
Dim Msg As Outlook.MailItem
If TypeName(Item) = "MailItem" Then
Set Msg = Item

'Change variables to match need. Comment or delete any part unnecessary.
If (Msg.SenderName = "Last, First") And _
(Msg.Subject = "Daily Report") And _
(Msg.Attachments.Count >= 1) Then

' open wkbk and run import macro
Dim olDestFldr As Outlook.MAPIFolder
Dim myAttachments As Outlook.Attachments
Dim XLApp As Object ' Excel.Application
Dim XlWK As Object ' Excel.Workbook
Dim Att As String

'location to save in. Can be root drive or mapped network drive.
Const attPath As String = "G:\Report\TA\"

'Set olDestFldr = objNS.Folders("TA_Reports").Folders
'Set objFolder = myParentFolder.Folders.Item("~Filtered Spam")

' New Excel.Application
Set XLApp = CreateObject("Excel.Application")

' save attachment
Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Att


' open personal.xls where macro is stored,
' just in case it doesn't open on its own
On Error Resume Next
XLApp.Workbooks.Open _
("C:\Documents and Settings\Application Data\Microsoft\Excel\XLSTART\PERSONAL.XLSB")
On Error GoTo 0

' open workbook and run macro
XLApp.Workbooks.Open ("C:\Documents and Settings\Application Data\Microsoft\Excel\XLSTART\PERSONAL.XLSB")

XLApp.Run ("PERSONAL.XLSB!TA_Unzip")
XLApp.Workbooks.Close
Kill attPath & Att
XLApp.Quit

' Get a reference to the Access Application object.
Set appAccess = CreateObject("Access.Application")

' open TA database and build reports with timer pause to allow time to run
Dim tim As Long
appAccess.OpenCurrentDatabase ("G:\Report\TA\TA.accdb")
tim = Timer
Do While Timer < tim + 2
DoEvents
Loop


' hide the application.
appAccess.Visible = False
appAccess.DoCmd.RunMacro "Report Process"
' Close the database and quit Access
appAccess.CloseCurrentDatabase
appAccess.Quit

' Close the object variable.
Set appAccess = Nothing



' mark as read and move to msgs folder
Msg.UnRead = False
'Msg.Move olDestFldr
End If
End If
ProgramExit:
Exit Sub

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

I am learning as I go so any help is greatly appreciated! :help

Thanks for your time,

Regards:

G

[JP2112]

G,

Please use code tags when posting code.

your code goes here

What I would do is, instead of your If statement that looks for a particular sender, create a Select Case statement that checks the sender name and saves it to a folder with that name.

Instead of setting the folder location as a constant, set the variable's value in the Select Case statement. You'll also need to write code that checks for the existence of the folder on the hard drive and creates it if necessary.

For example,


If Msg.subject = "Daily Report" And _
Msg.Attachments.count >= 1 Then
Select Case Msg.SenderName
Case "Smith, John"
attPath = "G:\Report\John Smith\"
Case "Jones, Mary"
attPath = "G:\Report\Mary Jones\"
Case Else ' if name doesn't match
attPath = "G:\Report\TA\"
End Select
End If


FYI it looks like you are opening PERSONAL.XLSB twice.

[telepicker]

JP - Thanks for the reply. I have read many of your posts in the forum and gained some valuable knowledge. I will give this a try today. Also thanks for pointing out the dup. I appreciate your time and skill!

G

[telepicker]

JP

To complicate this just a little more, for me anyway, I see how you are showing me to use case based on the Sender, but how would include checking for a unique subject as well?

In other words the subject and the sender would be related to each other, and then that would determine what location path I would save the attachment to.


If Msg.subject = "Daily Report" And _ Msg.Attachments.count >= 1 Then
Select Case Msg.SenderName
Case "Smith, John"
attPath = "G:\Report\John Smith\"
Case "Jones, Mary"
attPath = "G:\Report\Mary Jones\"
Case Else ' if name doesn't match
attPath = "G:\Report\TA\"
End Select
End If

[telepicker]

Still working to get this working. I think what I am missing is knowing how to make the the Msg.subject a variable or perhaps an array.

I will cleary know what the different subject line(s) will be so that can be hard coded, as well as the names of the Msg.SenderName(s). I believe what JP2112 using the Select Case is the answer to my issue, I am just not not clear how to choose different Subject(s) AND different Senders.

In other words the Subject will be unique to "trigger" my other code/events to run.

It is important to understand that I would be saving the attachments in different file locations based on subject and sender. Additional I would likely perform different 'functions' on that particular attachment.

For example:
In the code I have posted the attachment is a zip file (Excel Workbook). So on receipt - I unzip and save the excel file to particular folder. Then I start Access and import the excel in to Access as a a linked table and then run a series of macros to build 2 automated reports. Once that completes I then send the reports out through Outlook.

In the case of other attachments from different Senders I may just need to save the file or save it and then perform a different action.

So would these different functions/actions actually be under each Case rather than after Select case?

If I sound confused - I am somewhat.

Again I appreciate any and all help.:banghead:

[JP2112]

Can you provide some examples of different subjects and senders?

[telepicker]

JP - you must be a mind reader as well - I was just reading your Bio on your web site.

Thanks for getting back to me. I am pretty much following the same path as you, but just starting. I am doing my best to read, google and whatever else it takes to understand VBA - I love the automation.

Here are 3 examples:




rachel.johnson@ltr.com subject: TT Daily Report (Excel)

rich.winkle@ltr.com subject: UMTA (Excel)

johnny@gmail.com subject: 2011 Daily SS (.pdf)


Again I really appreciate your time and talents,

Regards,

G

[BrianMH]

once you hit a case you could do a if statement


If Msg.Attachments.count >= 1 Then
Select Case Msg.SenderName
Case "Smith, John"
if msg.subject = "subject to test" then
attPath = "G:\Report\John Smith\"
elseif msg.subject = "another subject"
attPath = "G:\A\nother\path
else
end if
'..further code
end case

or you could nest case statements.

[JP2112]

There are many different ways to check the subject. The simplest way would be something like

Dim msgSubject As String

msgSubject = Msg.Subject

Select Case msgSubject
Case "TT Daily Report", "UMTA", "2011 Daily SS"
' do nothing
Case Else ' not a matching subject
Exit Sub
End Select


This code would be placed before the code that checks the sender (to determine the save folder). And of course you would need to change the Select Case statement I posted, because now you are checking for the subject separately.


If Msg.Attachments.count >= 1 Then
Select Case Msg.SenderName
Case "Smith, John"
attPath = "G:\Report\John Smith\"
Case "Jones, Mary"
attPath = "G:\Report\Mary Jones\"
Case Else ' if name doesn't match
attPath = "G:\Report\TA\"
End Select
End If


You mentioned that the folder location depends on the subject AND sender. In my code above, the folder location is determined only by the sender name. If you need the folder location to adjust depending on both the subject and the sender name, you need to provide more examples.

[telepicker]

Thanks.

Basically the paths would be the same naming convention as the subject.
So it would be something like



rachel.johnson@ltr.com subject: TT Daily Report (Excel)
attPath = "G:\Reports\TT Daily Report\"


rich.winkle@ltr.com subject: UMTA (Excel)

attPath = "G:\Reports\UMTA Report\"

johnny@gmail.com subject: 2011 Daily SS (.pdf)

attPath = "G:\Reports\2011 Daily SS Report\"



So I am starting to see where you are going with this.
Can the Select Case be 2 conditions? Meaning Subject AND Sender?

I guess beyond how to code it correctly is my confusion on the additional "functions" that I want to perform based on the specific attachment being received from the Sender and Subject check.

Is the below correct, close or am I completely off base?



If Msg.Attachments.count >= 1 Then
Select Case Msg.SenderName AND msgSubject
Case "Johnson, Rachel"
' open wkbk and run import macro
Dim olDestFldr As Outlook.MAPIFolder
Dim myAttachments As Outlook.Attachments
Dim XLApp As Object ' Excel.Application
Dim XlWK As Object ' Excel.Workbook
Dim Att As String

'location to save in. Can be root drive or mapped network drive.
Const attPath As String = "attPath = "G:\Reports\TT Daily Report\"
' New Excel.Application
Set XLApp = CreateObject("Excel.Application")

' save attachment
Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Att

' Then do what ever if the the Sender And Subject matched a different case: ??

Case "Jones, Mary"
attPath = "G:\Report\Mary Jones\"
Case Else ' if name doesn't match
attPath = "G:\Report\TA\"
End Select
End If




Thanks for following up. Again I appreciate your time.

[BrianMH]

Personally if you want to check 2 conditions at once I would use the if statement.

Just to be clear you are not looking to just save the files to a folder you want to also do further functions to them?

In that case I would write seperate subs and call them when you need to. This saves quite a bit rewriting of code.

[telepicker]

Brian - yes Sir you are correct, "I not looking to just save the files to a folder you want to also do further functions" and those functions would be different for each instance.

The seperate subs may also bit a point of confusion for me as a "self-learner".

So if I understand you correctly I could basically reuse my original code (modified to fit the instance) multiple times as different named subs?

I have this code in the ThisOutlookSession - so that would work?

Thanks,

G

[BrianMH]

I know the feeling when your self learning. Everything seems so big. When dealing with seperate subs and functions it is handy to pass variables off to them. If I were you I would have a bit of a read about passing variables or objects.

With out seeing what you specifically want to do it is hard to give detailed explanations. But say you wanted to download the attachment and then once the attachment was downloaded you wanted to do something with it you could seperate these processes.

For instance you download the attachment to a specific path. You keep this path as a string then you could say open it in excel and do 10 things with it while in excel and save and close it. Well if you do this in one sub you would have to put all that code in for each different if statement OR you can just call that new sub giving it the path to the attachment from your if statement and you have only typed it once.

Hope that helps clarify. Also can you edit your original post and include vba tags?

[telepicker]

Hello All,

I have a cobbled together code that basically looks for an email from a specific sender with a specific subject line. Once that email is received then my code saves the attachment to the designated folder and the kicks off some macros in Access.

My problem/question is this.. How can I modify this code so that I can run the process on different different senders sending different attachments. This would all be excel attachments.

I would like to be able to specify a save to folder for each individual sender, but if I can not I could create a single Inbound Attachments folder.

Here is my code:


Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)


On Error GoTo ErrorHandler

'Only act if it's a MailItem
Dim Msg As Outlook.MailItem
If TypeName(Item) = "MailItem" Then
Set Msg = Item

'Change variables to match need. Comment or delete any part unnecessary.
If (Msg.SenderName = "Last, First") And _
(Msg.Subject = "Daily Report") And _
(Msg.Attachments.Count >= 1) Then

' open wkbk and run import macro
Dim olDestFldr As Outlook.MAPIFolder
Dim myAttachments As Outlook.Attachments
Dim XLApp As Object ' Excel.Application
Dim XlWK As Object ' Excel.Workbook
Dim Att As String

'location to save in. Can be root drive or mapped network drive.
Const attPath As String = "G:\Report\TA\"

'Set olDestFldr = objNS.Folders("TA_Reports").Folders
'Set objFolder = myParentFolder.Folders.Item("~Filtered Spam")

' New Excel.Application
Set XLApp = CreateObject("Excel.Application")

' save attachment
Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Att


' open personal.xls where macro is stored,
' just in case it doesn't open on its own
On Error Resume Next
XLApp.Workbooks.Open _
("C:\Documents and Settings\Application Data\Microsoft\Excel\XLSTART\PERSONAL.XLSB")
On Error GoTo 0

' open workbook and run macro
XLApp.Workbooks.Open ("C:\Documents and Settings\Application Data\Microsoft\Excel\XLSTART\PERSONAL.XLSB")

XLApp.Run ("PERSONAL.XLSB!TA_Unzip")
XLApp.Workbooks.Close
Kill attPath & Att
XLApp.Quit

' Get a reference to the Access Application object.
Set appAccess = CreateObject("Access.Application")

' open TA database and build reports with timer pause to allow time to run
Dim tim As Long
appAccess.OpenCurrentDatabase ("G:\Report\TA\TA.accdb")
tim = Timer
Do While Timer < tim + 2
DoEvents
Loop


' hide the application.
appAccess.Visible = False
appAccess.DoCmd.RunMacro "Report Process"
' Close the database and quit Access
appAccess.CloseCurrentDatabase
appAccess.Quit

' Close the object variable.
Set appAccess = Nothing



' mark as read and move to msgs folder
Msg.UnRead = False
'Msg.Move olDestFldr
End If
End If
ProgramExit:
Exit Sub

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



I am learning as I go so any help is greatly appreciated! :help

Thanks for your time,

Regards:

G[/quote]

[telepicker]

Apparently I am not able to edit the original post.

[BrianMH]

well first off you want to set the path that the attachments go into. so it would be


dim attPath as string

if Msg.sender="rachel.johnson@ltr.com" and msg.subject="TT Daily Report (Excel)" then
attPath = "G:\Reports\TT Daily Report\"
elseif msg.sender="rich.winkle@ltr.com" and msg.subject="UMTA (Excel)" then
attPath = "G:\Reports\UMTA Report\"
elseif msg.sender="johnny@gmail.com" and msg.subject="2011 Daily SS (.pdf)"
attPath = "G:\Reports\2011 Daily SS Report\"
else
attPath = "G:\Reports\uncategorized"
end if


' save attachment
Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Att

If your code is working for you already you can just update this bit.

BTW it is good practice to do all your declarations at the top instead of throughout the sub. It is also best to use objects when you can and name the variables and constants based on what type they are.

For instance I would have named your attPath as strPath. Hope that helps

[telepicker]

I just had a chance to try this. I modified as above but now I am getting an error on this section:


myAttachments.Item(1).SaveAsFile attPath & Att


At this point I am guessing but it appears Outlook does not know which or what my path actually is to save the attachment to.

[BrianMH]

What is the error message?

Does the folder you are trying to download to exist?

btw G:\Reports\uncategorized should be G:\Reports\uncategorized\

[telepicker]

:banghead: Ok so I verified the destination folders do exist - including uncategorized. I limited the code for testing purposes to only strip the attachment and then save it to the designated folder.

But - It does not recognize the combination of Sender AND subject so it simply moves the attachment in to the uncategorized folder.

Which I would like to remove as even if the other part was working I really do not want to strip other attachments from emails that do have anything to do with these 3 topics.

Here is the code I am testing with:


Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)

On Error GoTo ErrorHandler
'Only act if it's a MailItem
Dim Msg As Outlook.MailItem
If TypeName(Item) = "MailItem" Then
Set Msg = Item
Dim attPath As String

If Msg.Sender = "someones@ltr.com And Msg.Subject = "Test1" Then
attPath = "G:\Daily\Test\TT Report\"
ElseIf Msg.Sender = "someoneelse@ltr.com And Msg.Subject = "Test2" Then
attPath = "G:\Daily\Test\UMTA Report\"
ElseIf Msg.Sender = "another@gmail.com" And Msg.Subject = "Test3" Then
attPath = "G:\Daily\Test\2011 Daily Report\"
Else
attPath = "G:\Daily\Test\uncategorized\"
End If

' save attachment
Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Att

' mark as read and move to msgs folder
Msg.UnRead = False
'Msg.Move olDestFldr
End If
ProgramExit:
Exit Sub

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



So I can see a light - but is it a train?

[telepicker]

:rotlaugh: BTW - I no longer am getting the error on this or any other line after "trimming down the code.


myAttachments.Item(1).SaveAsFile attPath & Att

[BrianMH]

Right so remove the last else statement.

Does your subject have spaces at the beginning or end? If so you might want to try

msg.subject like "*test2*" or
trim(msg.subject) = "test2"

[JP2112]

I think the property you want is SenderEmailAddress, not Sender.

[telepicker]

There are no spaces in the subject line - verified before sending test messages.

Also the error message is coming up again on this line when I debug:


Att = myAttachments.Item(1).DisplayName

[telepicker]

JP so Sender would literal like the display name "Zapa, Frank" etc where SenderEmailAddress is looking for the exact email address.

I get that - if that is the case.

So I updated my code to include SenderEmailAddress as below and still does not strip the attachment.



Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)

On Error GoTo ErrorHandler
'Only act if it's a MailItem
Dim Msg As Outlook.MailItem
If TypeName(Item) = "MailItem" Then
Set Msg = Item
Dim attPath As String

If Msg.SenderEmailAddress = "someone@ltr.com" And Msg.Subject = "Test1" Then
attPath = "G:\Daily \Test\TT Report\"
ElseIf Msg.SenderEmailAddress = "someoneelse@ltr.com" And Msg.Subject = "Test2" Then
attPath = "G:\Daily \Test\UMTA Report\"
ElseIf Msg.SenderEmailAddress = another@gmail.com And Msg.Subject = "Test3" Then
attPath = "G:\Daily \Test\2011 Daily Report\"
End If

' save attachment
Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Att

' mark as read and move to msgs folder
Msg.UnRead = False
'Msg.Move olDestFldr
End If
ProgramExit:
Exit Sub

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

[BrianMH]

It won't strip the attachment off but it should save it. If it is not saving is it giving you an error message? I don't have outlook at home so can't test it here. I can have a look at work tomorrow but any error messages would be helpful.

[telepicker]

Sorry mis-spoke about stripping. Right now I am not getting any error. I have watched the process and when I receive the file it marks the email as read in Outlook but does not save the attachment anywhere.

[BrianMH]

Are you sure you have the exact subject and name in the code. F8 to debug and when you get to msg.senderemailaddress hover over it and see if it is showing up right. Do the same with the subject. Did you try the trim or like bits? If the subject is off by 1 space it won't work.

[telepicker]

Yes subject and name is verified (more than twice). I am typing in the subject line so there are no space - verified that many times as well.

Thanks for the follow up.

[BrianMH]

Ok will test tomorrow at work when I get a chance unless someone sees the obvious that I'm not seeing. Which is likely lol.

[BrianMH]

ElseIf Msg.SenderEmailAddress = another@gmail.com And Msg.Subject = "Test3" Then
needs to be ElseIf Msg.SenderEmailAddress = "another@gmail.com" And Msg.Subject = "Test3" Then
this was driving me nuts so I installed outlook and tested it and it is working for me. It will overwrite any file that is already there though it won't be like file.txt file(1).txt.

[telepicker]

Unfortunately I can not test until in the am - I will load it up and check then let you know how it goes. I really appreciate your staying with me on this. Thanks for your time and patience!:beerchug:

[BrianMH]

Private WithEvents Items As Outlook.Items
Option Explicit

Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)

Dim Msg As Outlook.MailItem
Dim attPath As String
Dim Att As String
Dim myAttachments As Attachments
Dim boolDownload As Boolean
boolDownload = False

On Error GoTo ErrorHandler
'Only act if it's a MailItem

If TypeName(Item) = "MailItem" Then
Set Msg = Item


If Msg.SenderEmailAddress = "someone@ltr.com" And Msg.Subject = "Test1" Then
attPath = "G:\Daily \Test\TT Report\"
boolDownload = True
ElseIf Msg.SenderEmailAddress = "someoneelse@ltr.com" And Msg.Subject = "Test2" Then
attPath = "G:\Daily \Test\UMTA Report\"
boolDownload = True
ElseIf Msg.SenderEmailAddress = "email@gmail.com" And Msg.Subject = "test1" Then
attPath = "C:\Users\Brian\Desktop\"
boolDownload = True
End If
If boolDownload = True Then
' save attachment
Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Att

' mark as read and move to msgs folder
Msg.UnRead = False
'Msg.Move olDestFldr
End If
End If
ProgramExit:
Exit Sub

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



I have updated the code so that if the subject and sender don't match it won't attempt to download and it won't mark it as unread. This is better behavior and should also help you debug it.

[telepicker]

Ok this was a little odd. My mail comes through an Outlook Exchange server not sure if this was the cause but for internal emails with attachments to work I had to resort back to using

ElseIf Msg.Sender = "someoneelse@ltr.com" And Msg.Subject = "Test2" Then
attPath = "G:\Daily \Test\UMTA Report\"
boolDownload = True


For external email such as gmail the Msg.SenderEmailAddress works but not Msg.Sender.

So this all works as far as saving the attachments. My next step is to perform the functions on the saved attachments and verify that will work.

Brian - I really appreciate you help on this. I will post results after I have tested adding the functions in. Perhaps when completed this will also help someone else.

[BrianMH]

Hi,

Here is your code modified to use objects more. It also should work for both internal and external mails if the issues you mentioned are correct.

I mentioned before that your probably best to write seperate procedures to make it easier to take the appropriate actions. In this code I have included an example of what I mean. I created a very simple procedure called PopupPath that will pop up a message when passed a string saying where your file has been saved. As you can see in the main code I call this by typing call PopupPath(strfullpath) and this passes the string held in strfullpath to the procedure. Once you realise you can pass variables to seperate procedures its a game changer. Things you have to do many many times you no longer need type many many times.

Private WithEvents Items As Outlook.Items
Option Explicit

Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)

Dim myItem As Outlook.MailItem
Dim strAttPath As String
Dim strAtt As String
Dim strFullPath As String
Dim myAttachments As Attachments
Dim myAtt As Attachment


On Error GoTo ErrorHandler
'Only act if it's a MailItem

If TypeName(Item) = "MailItem" Then
Set myItem = Item

Set myAttachments = Item.Attachments
Set myAtt = myAttachments.Item(1)
strAtt = myAtt.DisplayName
strFullPath = strAttPath & strAtt

If (myItem.SenderEmailAddress = "someone@ltr.com" Or myItem.Sender = "someone@ltr.com") And myItem.Subject = "Test1" Then
strAttPath = "G:\Daily \Test\TT Report\"
myAtt.SaveAsFile strFullPath
Call PopupPath(strFullPath)
ElseIf (myItem.SenderEmailAddress = "someoneelse@ltr.com" Or myItem.Sender = "someoneelse@ltr.com") And myItem.Subject = "Test2" Then
strAttPath = "G:\Daily \Test\UMTA Report\"
myAtt.SaveAsFile strFullPath
Call PopupPath(strFullPath)
ElseIf (myItem.SenderEmailAddress = "email@gmail.com" Or myItem.Sender = "email@gmail.com") And myItem.Subject = "test1" Then
strAttPath = "C:\Users\Brian\Desktop\"
myAtt.SaveAsFile strFullPath
Call PopupPath(strFullPath)
End If
If boolDownload = True Then


' mark as read and move to msgs folder
myItem.UnRead = False
'myItem.Move olDestFldr
End If
End If
ProgramExit:
Exit Sub

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

Sub PopupPath(strpath As String)
MsgBox ("your file has been saved to " & strpath)
End Sub

[telepicker]

Brian - I had got knee deep in this before I saw your last post. I am not sure how to utilize the call portion you show.

I have the code working with as shown below (bottom); with one small issue.
When I receive a valid Sender & Subject combination with any attachment it kicks off this portion of my code:


' open personal.xls where macro is stored, and run macro
On Error Resume Next
XLApp.Workbooks.Open ("C:\Documents and Settings\gregory.l.young\Application Data\Microsoft\Excel\XLSTART\PERSONAL.XLSB")
On Error GoTo 0
XLApp.Run ("PERSONAL.XLSB!TA_Unzip")
XLApp.Workbooks.Close
Kill attPath & Att
XLApp.Quit

' Get a reference to the Access Application object.
Set appAccess = CreateObject("Access.Application")

' open TA database and build reports with timer pause to allow time to run
Dim tim As Long
appAccess.OpenCurrentDatabase ("G:\Daily\TA\TA.accdb")
tim = Timer
Do While Timer < tim + 2
DoEvents
Loop

' hide the application.
appAccess.Visible = False
appAccess.DoCmd.RunMacro "Report Process"

' Close the database and quit Access
'appAccess.CloseCurrentDatabase
'appAccess.Quit

' Close the object variable.
Set appAccess = Nothing



So I am guessing this is where the call would come in to play specific for the "event or funtion" I want to perform.

In other words I believe I have the Excel and Access code in the wrong place, I am just not sure where it should be placed so that it only runs for the specified Sender & Subject combination
:doh:


Private WithEvents Items As Outlook.Items
Option Explicit

Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)

Dim Msg As Outlook.MailItem
Dim attPath As String
Dim Att As String
Dim myAttachments As Attachments
Dim XLApp As Object ' Excel.Application
Dim appAccess As Object ' Access.Application
Dim XlWK As Object ' Excel.Workbook
Dim boolDownload As Boolean
boolDownload = False

On Error GoTo ErrorHandler
'Only act if it's a MailItem

If TypeName(Item) = "MailItem" Then
Set Msg = Item


If Msg.Sender = "Doe, Jane" And Msg.Subject = "Test1" Then
attPath = "G:\Daily\TA\"
boolDownload = True
ElseIf Msg.SenderEmailAddress = "someone@gmail.com" And Msg.Subject = "Test2" Then
attPath = "G:\Daily\TA\"
boolDownload = True
ElseIf Msg.Sender = "Doe, John" And Msg.Subject = "Test3" Then
attPath = "G:\Daily\TA\"
boolDownload = True
End If
If boolDownload = True Then

' open wkbk and run import macro
Dim olDestFldr As Outlook.MAPIFolder


' New Excel.Application
Set XLApp = CreateObject("Excel.Application")

' save attachment
Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Att


' open personal.xls where macro is stored, and run macro
On Error Resume Next
XLApp.Workbooks.Open ("C:\Documents and Settings\gregory.l.young\Application Data\Microsoft\Excel\XLSTART\PERSONAL.XLSB")
On Error GoTo 0
XLApp.Run ("PERSONAL.XLSB!TA_Unzip")
XLApp.Workbooks.Close
Kill attPath & Att
XLApp.Quit

' Get a reference to the Access Application object.
Set appAccess = CreateObject("Access.Application")

' open TA database and build reports with timer pause to allow time to run
Dim tim As Long
appAccess.OpenCurrentDatabase ("G:\Daily\TA\TA.accdb")
tim = Timer
Do While Timer < tim + 2
DoEvents
Loop

' hide the application.
appAccess.Visible = False
appAccess.DoCmd.RunMacro "Report Process"

' Close the database and quit Access
'appAccess.CloseCurrentDatabase
'appAccess.Quit

' Close the object variable.
Set appAccess = Nothing

' mark as read and move to msgs folder
Msg.UnRead = False
'Msg.Move olDestFldr
End If
End If
ProgramExit:
Exit Sub

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

[gcomyn]

If you don't want it to take attachments out of emails that don't meet the requirements, in the Else section, where you have the
attPath = "G:\Daily\Test\uncategorized\" put
goto ProgramExit

[this was from the bottom of page one... I didn't realize that there was another page of posts....]


Gcomyn
:sleuth:

[gcomyn]

After you get the attPath and the boolDownload variables set, after checking to see if the download is true, then use a case statement... such as:


Select Case attPath
Case "G:\Daily\Test\TA Reports\"
[code to process TA Reports]
Case "G:\Daily\Test\Test2\"
[code to process second report]
Case "G:\Daily\Test\Test3"
[code to process third report]
end select


or, in the if/then statements up above, you can also have another variable that you set to determine which type of report it is, and use that as the variable to check in the select case statement.

You can have the Attachment naming and such before the select case section, because that will be done with all of them, but once you get that done, you want to process them differently. To keep the code slimmer, you can have a function for each of the different processes, calling them with the full path of the attachment that you are processing.

Gcomyn
:sleuth:

[telepicker]

That seems like a viable solution I am just not sure where it goes within my existing code.

Being so new, and not fully understanding what is happening with the code causes me some issues. But alas I am learning.

[telepicker]

Guessing and questioning if it is really that simple but would it be like this?



If Msg.Sender = "Doe, Jane" And Msg.Subject = "Test1" Then
attPath = "G:\Daily\TA\"
boolDownload = True
ElseIf Msg.SenderEmailAddress = "someone@gmail.com" And Msg.Subject = "Test2" Then
attPath = "G:\Daily\TA\"
boolDownload = True
ElseIf Msg.Sender = "Doe, John" And Msg.Subject = "Test3" Then
attPath = "G:\Daily\TA\"
boolDownload = True
End If
If boolDownload = True Then

' open wkbk and run import macro
Dim olDestFldr As Outlook.MAPIFolder


' New Excel.Application
Set XLApp = CreateObject("Excel.Application")

' save attachment
Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Att


Select Case attPath
Case "G:\Daily\Test\TA Reports\"
[code To process TA Reports]
Case "G:\Daily\Test\Test2\"
[code To process second report]
Case "G:\Daily\Test\Test3"
[code To process third report]
End Select

[BrianMH]

What confuses me is that your code (at least the bit we can see) only seems to call other code and then delete the file. The other code in this function is that the same no matter which of the 3 files you download? Does the macro in the excel workbook take action to all the paths?

[telepicker]

Brian,

Here is the full code as it stands. It was posted above the snipet and a few other comments above.

For now any code actions should only be performed on the 1st Sender & Subject combination 2 and 3 are only testing that the attachment is saved on receipt from those 2 Sender & Subject.

But - Upon receipt of an valid Sender & Subject combination (i.e. conditions met for email 2 or 3) my code/actions/process that is supposed to be specific to email 1 kicks off.
In other words my code is not distinguishing when it should run and when it should not based on the email received.

I hope that makes sense :dunno

Here is what mode is actually doing:


Save the attachment to the designated folder.
Calling code from PERSONAL.XLSB!TA_Unzip and unzipping the attachment (As I know it will be in a zip file).
Saving the unzipped file to a new folder.
Close the Excel Personal Wkbook.
Opening Access 2010.
Importing the "saved file" (original attachment).
Running the macro "Report Process" which is a series of macros that creates an Excel report with multiple worksheets.
Programatically emails the reports to designated receipients (Access 2010 through Outlook 2010 with help from ClickYES).
Send completion email to my self for verification
Close Access
Mark the original email as read.
Private WithEvents Items As Outlook.Items
Option Explicit

Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)

Dim Msg As Outlook.MailItem
Dim attPath As String
Dim Att As String
Dim myAttachments As Attachments
Dim XLApp As Object ' Excel.Application
Dim appAccess As Object ' Access.Application
Dim XlWK As Object ' Excel.Workbook
Dim boolDownload As Boolean
boolDownload = False

On Error Goto ErrorHandler
'Only act if it's a MailItem

If TypeName(Item) = "MailItem" Then
Set Msg = Item


If Msg.Sender = "Doe, Jane" And Msg.Subject = "Test1" Then
attPath = "G:\Daily\TA\"
boolDownload = True
ElseIf Msg.SenderEmailAddress = "someone@gmail.com" And Msg.Subject = "Test2" Then
attPath = "G:\Daily\TA\"
boolDownload = True
ElseIf Msg.Sender = "Doe, John" And Msg.Subject = "Test3" Then
attPath = "G:\Daily\TA\"
boolDownload = True
End If
If boolDownload = True Then

' open wkbk and run import macro
Dim olDestFldr As Outlook.MAPIFolder


' New Excel.Application
Set XLApp = CreateObject("Excel.Application")

' save attachment
Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Att


' open personal.xls where macro is stored, and run macro
On Error Resume Next
XLApp.Workbooks.Open ("C:\Documents and Settings\gregory.l.young\Application Data\Microsoft\Excel\XLSTART\PERSONAL.XLSB")
On Error Goto 0
XLApp.Run ("PERSONAL.XLSB!TA_Unzip")
XLApp.Workbooks.Close
Kill attPath & Att
XLApp.Quit

' Get a reference to the Access Application object.
Set appAccess = CreateObject("Access.Application")

' open TA database and build reports with timer pause to allow time to run
Dim tim As Long
appAccess.OpenCurrentDatabase ("G:\Daily\TA\TA.accdb")
tim = Timer
Do While Timer < tim + 2
DoEvents
Loop

' hide the application.
appAccess.Visible = False
appAccess.DoCmd.RunMacro "Report Process"

' Close the database and quit Access
'appAccess.CloseCurrentDatabase
'appAccess.Quit

' Close the object variable.
Set appAccess = Nothing

' mark as read and move to msgs folder
Msg.UnRead = False
'Msg.Move olDestFldr
End If
End If
ProgramExit:
Exit Sub

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

[BrianMH]

Ok if I'm clear if it meets the conditions for the first email/subject combo you want it to do everything.

If it meets the conditions of the second and third combinations you want it to download the attachment but do nothing else?

if so then this should work

Private WithEvents Items As Outlook.Items
Option Explicit

Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)

Dim Msg As Outlook.MailItem
Dim attPath As String
Dim Att As String
Dim myAttachments As Attachments
Dim XLApp As Object ' Excel.Application
Dim appAccess As Object ' Access.Application
Dim XlWK As Object ' Excel.Workbook
Dim boolDownload As Boolean
boolDownload = False

On Error Goto ErrorHandler
'Only act if it's a MailItem

If TypeName(Item) = "MailItem" Then
Set Msg = Item

Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName

If Msg.Sender = "Doe, Jane" And Msg.Subject = "Test1" Then
attPath = "G:\Daily\TA\"
boolDownload = True
myAttachments.Item(1).SaveAsFile attPath & Att
ElseIf Msg.SenderEmailAddress = "someone@gmail.com" And Msg.Subject = "Test2" Then
attPath = "G:\Daily\TA\"
myAttachments.Item(1).SaveAsFile attPath & Att

ElseIf Msg.Sender = "Doe, John" And Msg.Subject = "Test3" Then
attPath = "G:\Daily\TA\"
myAttachments.Item(1).SaveAsFile attPath & Att
End If
If boolDownload = True Then

' open wkbk and run import macro
Dim olDestFldr As Outlook.MAPIFolder


' New Excel.Application
Set XLApp = CreateObject("Excel.Application")




' open personal.xls where macro is stored, and run macro
On Error Resume Next
XLApp.Workbooks.Open ("C:\Documents and Settings\gregory.l.young\Application Data\Microsoft\Excel\XLSTART\PERSONAL.XLSB")
On Error Goto 0
XLApp.Run ("PERSONAL.XLSB!TA_Unzip")
XLApp.Workbooks.Close
Kill attPath & Att
XLApp.Quit

' Get a reference to the Access Application object.
Set appAccess = CreateObject("Access.Application")

' open TA database and build reports with timer pause to allow time to run
Dim tim As Long
appAccess.OpenCurrentDatabase ("G:\Daily\TA\TA.accdb")
tim = Timer
Do While Timer < tim + 2
DoEvents
Loop

' hide the application.
appAccess.Visible = False
appAccess.DoCmd.RunMacro "Report Process"

' Close the database and quit Access
'appAccess.CloseCurrentDatabase
'appAccess.Quit

' Close the object variable.
Set appAccess = Nothing

' mark as read and move to msgs folder
Msg.UnRead = False
'Msg.Move olDestFldr
End If
End If
ProgramExit:
Exit Sub

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

[telepicker]

Yes - that is exactly what I am trying to accomplish.

I see where you have associated the
myAttachments.Item(1).SaveAsFile attPath & Att


to each mail item. My question is how does this explicitly associate the Excel and Access macros to mail item 1?

What if I needed (and I will) to run a different Macro or other function explicitly for mail tem 2 or 3 individually?

Should I go back and build from the method you posted
Yesterday, 12:41 PM post # 34 and incorporate the Call method?

It looked very neat and clean - I just do not understand how to apply the call for each seperate instance based on the mail item. I get the concept just not the format of how to code it.

I believe it would be a different set of "functions or actions" for each call type and then associate them to the mail item as they apply. Is that the idea?

[BrianMH]

Private WithEvents Items As Outlook.Items
Option Explicit

Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)

Dim myItem As Outlook.MailItem
Dim strAttPath As String
Dim strAtt As String
Dim strFullPath As String
Dim myAttachments As Attachments
Dim myAtt As Attachment
Dim olDestFldr As Outlook.MAPIFolder


On Error GoTo ErrorHandler
'Only act if it's a MailItem

If TypeName(Item) = "MailItem" Then
Set myItem = Item

Set myAttachments = Item.Attachments
Set myAtt = myAttachments.Item(1)
strAtt = myAtt.DisplayName
strFullPath = strAttPath & strAtt

If (myItem.SenderEmailAddress = "someone@ltr.com" Or myItem.Sender = "someone@ltr.com") And myItem.Subject = "Test1" Then
strAttPath = "G:\Daily \Test\TT Report\"
myAtt.SaveAsFile strFullPath
Call xlAcsub(strFullPath)
myItem.UnRead = False
'myItem.Move olDestFldr

ElseIf (myItem.SenderEmailAddress = "someoneelse@ltr.com" Or myItem.Sender = "someoneelse@ltr.com") And myItem.Subject = "Test2" Then
strAttPath = "G:\Daily \Test\UMTA Report\"
myAtt.SaveAsFile strFullPath
'Call anothersub
myItem.UnRead = False
'myItem.Move olDestFldr

ElseIf (myItem.SenderEmailAddress = "email@gmail.com" Or myItem.Sender = "email@gmail.com") And myItem.Subject = "test1" Then
strAttPath = "C:\Users\Brian\Desktop\"
myAtt.SaveAsFile strFullPath
'Call stillanothersub
myItem.UnRead = False
'myItem.Move olDestFldr

End If


End If
ProgramExit:
Exit Sub

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

Sub xlAcsub(strToKill As String)
On Error GoTo ErrorHandler
Dim XLApp As Object ' Excel.Application
Dim appAccess As Object ' Access.Application
Dim XlWK As Object ' Excel.Workbook
Dim tim As Long
Set XLApp = CreateObject("Excel.Application")
Set appAccess = CreateObject("Access.Application")

XLApp.Workbooks.Open ("C:\Documents and Settings\gregory.l.young\Application Data\Microsoft\Excel\XLSTART\PERSONAL.XLSB")
XLApp.Run ("PERSONAL.XLSB!TA_Unzip")
XLApp.Workbooks.Close
Kill strToKill
XLApp.Quit

tim = Timer
Do While Timer < tim + 2
DoEvents
Loop
appAccess.Visible = False
appAccess.DoCmd.RunMacro "Report Process"
' Close the database and quit Access
'appAccess.CloseCurrentDatabase
'appAccess.Quit

' Close the object variable.
Set appAccess = Nothing

ProgramExit:
Exit Sub

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



This should be more like what your looking for. Personally I would add references to excel and access and code it all in outlook instead of calling the functions in those applications but thats just my personal preference. I left quite a bit of your commented out code in because I wasn't sure what you were wanting to uncomment in the future.

Hope that clears it up a bit. I would also suggest you do some reading about vba functions and passing variables. Once you understand this it will really help your coding. Another helpful bit is to learn to assign object variables instead of using references to them.

ie


sub openandcloseworkbook
dim wbToOpen as workbook
set wbToOpen = workbooks.open("C:\workbook.xls")
wbToOpen.close false
end sub

instead of


sub openandcloseworkbook
workbooks.open("C:\workbook.xls")
workbooks("workbook.xls").close false
end sub


when you define objects as what they are when you type wbToOpen. <
you will get a dropdown of all the options you have to work with this object.

[telepicker]

Brian - thank you. I have not had a chance to try this yet. I will let you know as soon as I do. Thanks again for staying with me on this.

[BrianMH]

No problem. Got to keep busy. Idle hands and all :D.

[telepicker]

I have test the code this am it does not save the attachment file. The only part that is working is the

myItem.UnRead = False
'myItem.Move olDestFldr

[BrianMH]

Can't see anything that would cause it not to work. Do you get an error message?

[telepicker]

The code did not through an error it just failed to save the attachment or call the script.
I am trying to work through debugging now - I will follow up when I either

1) succeed
2) fail
3) get lost

Thanks for keeping an eye out.

[telepicker]

:clap: Thanks to Brian, I have finally resolved this completely and it works tremendously! I am posting trhe code with the names of the drives and email senders to protect the guilty.

:cloud9: Hopefully this will help someone else out somewhere down the line.
Here is what the code is actually doing:


Checks Outlook inbox for a specific MSG Sender and MSG Subject with an attachment. (Not tested on any file type other than Excel, but I would believe it could process any type of attachment).
If there is a match then the attachement is saved in the designated folder.
If Sender or Subject does not match then no action is taken.
In my code If the email from Sender, Joe has a zip file attached, the Sub TA_Unzip is called and the zip file is automatically unzipped and saved in the designated location. I use XStandard.ZIP - google it and you will find it easily - free app you just need to save the .dll file and make it active in your Resources - Library.
After that file is unzipped then the Sub Opens an Access db, imports the file and then process through 10 different macros to produce various reports.
When completed the reports are automatically emailed through Outlook 2010 (Must use an like ClickYes to work around the security pop-ups in Outlook).Here is the code:


Private WithEvents Items As Outlook.Items
Option Explicit

Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)

Dim Msg As Outlook.MailItem
Dim attPath As String
Dim Att As String
Dim strFullPath As String
Dim myAttachments As Attachments
Dim myAtt As Attachment
Dim olDestFldr As Outlook.MAPIFolder


On Error GoTo ErrorHandler
'Only act if it's a MailItem

If TypeName(Item) = "MailItem" Then
Set Msg = Item
Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Att
If (Msg.Sender = "Sender, Joe") And _
(Msg.Subject = "My Report") And _
(Msg.Attachments.Count >= 1) Then
attPath = "G:\Daily Report\Reports\"
myAttachments.Item(1).SaveAsFile attPath & Att
Call Report_Unzip
Msg.UnRead = False
'Msg.Move olDestFldr

ElseIf (Msg.Sender = "Jane Sender") And _
(Msg.Subject = "Test Mail 2") And _
(Msg.Attachments.Count >= 1) Then
attPath = "I:\Mail\"
myAttachments.Item(1).SaveAsFile attPath & Att
Msg.UnRead = False
'Msg.Move olDestFldr

ElseIf (Msg.Sender = "Mail Subscriptions") And _
(Msg.Subject = "Test Mail 3") And _
(Msg.Attachments.Count >= 1) Then
attPath = "C:\Documents and Settings\myfolder name\My Documents\Test File\"
myAttachments.Item(1).SaveAsFile attPath & Att
Msg.UnRead = False
'Msg.Move olDestFldr


End If
End If
ProgramExit:
Exit Sub

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

Sub TA_Unzip()
On Error GoTo ErrorHandler
Dim appAccess As Object ' Access.Application
Dim objZip
Set objZip = CreateObject("XStandard.Zip")
objZip.UnPack "G:\Daily Report\Reports\Daily_Report.zip", "G:\Daily Report\Reports\"
Set objZip = Nothing
' Get a reference to the Access Application object.
Set appAccess = CreateObject("Access.Application")

' open TA database and build reports with timer pause to allow time to run
Dim tim As Long
appAccess.OpenCurrentDatabase ("G:\Daily Report\Reports\Report_db.accdb")
tim = Timer
Do While Timer < tim + 2
DoEvents
Loop

' hide the application.
appAccess.Visible = False
appAccess.DoCmd.RunMacro "Report Process"

' Close the database and quit Access
appAccess.CloseCurrentDatabase
appAccess.Quit

' Close the object variable.
Set appAccess = Nothing
ProgramExit:
Exit Sub

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




Thanks Brian and also to JP2112 for getting me on the path!

Regards,
Greg

[telepicker]

:bug: Ok I may have jumped too soon. It appears I have a small issue.

I am getting
Run-time error '-2147352567 (80020009)':
Array index out of bounds.

When I Debug it highlights this line of code:

Att = myAttachments.Item(1).DisplayName


Any thoughts on what I messed up here?

[telepicker]

BTW - this prompted when I receive an email from a Sender that is not part of my If.. ElseIf code.

I am guessing the code would like to see something that says if it isn't one these Senders then take no action.:dunno

[BrianMH]

Sorry been away for a bit. Just add and else (not elseif) to the end of the if statement and either say exit sub or goto programexit

That should sort it for you.

[telepicker]

Brian - That resolved it.
I have definetly learned many things over the past few weeks.
I sincerely appreciate your help.

Regards,

Greg

[telepicker]

:banghead: Ok - so no it didn't resolve it. It worked fine on the 1st email that meet the criteria I received this am. Then when I received another email that did not meet my criteria I received the error in a message box.

See post #50 for full code - with the exception of adding the Else to the end of the statemnt.

Same error message:
Run-time error '-2147352567 (80020009)':
Array index out of bounds


Debugging shows this line as issue:


Att = myAttachments.Item(1).DisplayName


I added the Else as you suggested. Below is the last ElseIF statement of the code.



ElseIf (Msg.Sender = "Mail Subscriptions") And _
(Msg.Subject = "Test Mail 3") And _
(Msg.Attachments.Count >= 1) Then
attPath = "C:\Documents and Settings\myfolder name\My Documents\Test File\"
myAttachments.Item(1).SaveAsFile attPath & Att
Msg.UnRead = False
'Msg.Move olDestFldr

Else

Exit Sub

End If
End If
ProgramExit:
Exit Sub

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

[telepicker]

BTW - If I hoover over the highlighted line it shows

Att = ""

Whatever, if anything, that may be trying to tell me.

[BrianMH]

Your trying to download the file before you have confirmed it meets the criteria. I bet that email that gave an error had no attachment.

If TypeName(Item) = "MailItem" Then
Set Msg = Item
Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Att
If (Msg.Sender = "Sender, Joe") And _
get rid of myAttachments.Item(1).SaveAsFile attPath & Att

[telepicker]

I have removed that line - will follow up after testing.

Thanks!

[telepicker]

Nope - still getting the error msg window.
It was an email with no attachment that caused it.
Same line being highlighted:


If TypeName(Item) = "MailItem" Then
Set Msg = Item
' save attachment
Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName

[BrianMH]

Private WithEvents Items As Outlook.Items
Option Explicit

Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)

Dim Msg As Outlook.MailItem
Dim attPath As String
Dim Att As String
Dim strFullPath As String
Dim myAttachments As Attachments
Dim myAtt As Attachment
Dim olDestFldr As Outlook.MAPIFolder


On Error Goto ErrorHandler
'Only act if it's a MailItem

If TypeName(Item) = "MailItem" and Item.Attachments.Count > 0 then
Set Msg = Item
Set myAttachments = Item.Attachments

If (Msg.Sender = "Sender, Joe") And _
(Msg.Subject = "My Report") Then
attPath = "G:\Daily Report\Reports\"
myAttachments.Item(1).SaveAsFile attPath & Att
Call Report_Unzip
Msg.UnRead = False
'Msg.Move olDestFldr

ElseIf (Msg.Sender = "Jane Sender") And _
(Msg.Subject = "Test Mail 2") Then
attPath = "I:\Mail\"
myAttachments.Item(1).SaveAsFile attPath & Att
Msg.UnRead = False
'Msg.Move olDestFldr

ElseIf (Msg.Sender = "Mail Subscriptions") And _
(Msg.Subject = "Test Mail 3") Then
attPath = "C:\Documents and Settings\myfolder name\My Documents\Test File\"
myAttachments.Item(1).SaveAsFile attPath & Att
Msg.UnRead = False
'Msg.Move olDestFldr


End If
End If
ProgramExit:
Exit Sub

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

Sub TA_Unzip()
On Error Goto ErrorHandler
Dim appAccess As Object ' Access.Application
Dim objZip
Set objZip = CreateObject("XStandard.Zip")
objZip.UnPack "G:\Daily Report\Reports\Daily_Report.zip", "G:\Daily Report\Reports\"
Set objZip = Nothing
' Get a reference to the Access Application object.
Set appAccess = CreateObject("Access.Application")

' open TA database and build reports with timer pause to allow time to run
Dim tim As Long
appAccess.OpenCurrentDatabase ("G:\Daily Report\Reports\Report_db.accdb")
tim = Timer
Do While Timer < tim + 2
DoEvents
Loop

' hide the application.
appAccess.Visible = False
appAccess.DoCmd.RunMacro "Report Process"

' Close the database and quit Access
appAccess.CloseCurrentDatabase
appAccess.Quit

' Close the object variable.
Set appAccess = Nothing
ProgramExit:
Exit Sub

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

Try that, it was trying to assign the attachment name to att where there was no attachment to save.

[telepicker]

Trying it now - with a test email and attachment.

[BrianMH]

try it with an email that doesn't have an attachment too since that is what caused your error.

[telepicker]

Ok I had one of my Senders send me an email with attachment. The code stopped at the highlighted line:
Error - Path does not exist (but yes it does)

ElseIf (Msg.Sender = "Sender, Jane") And _
(Msg.Subject = "WV UMTS Backlog") And _
(Msg.Attachments.Count >= 1) Then
attPath = "I:\UTMS_WV\Process\"
myAttachments.Item(1).SaveAsFile attPath & Att
Call Mail_Working
Msg.UnRead = False
'Msg.Move olDestFldr

[BrianMH]

Are you sure the drive isn't mapped differently or maybe the path is spelled slightly differently? Is there any special permissions on the folder?

[telepicker]

Ok I had one of my known Sender send an email with attachment (meets criteria).

I received msg box: "Cannot save the attachment. Path does not exist. Verify the path is correct."


attPath = "I:\Mail\"

[telepicker]

No path not changed. Remember this worked as it should with the exception of throwing the error when an unmatched email arrived.

Here are the on;y changes that i have made:

1). get rid of myAttachments.Item(1).SaveAsFile attPath & Att
then
2). Changed


If TypeName(Item) = "MailItem" Then
Set Msg = Item
' save attachment
Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Att

To this

If TypeName(Item) = "MailItem" And Item.Attachments.Count > 0 Then
Set Msg = Item
Set myAttachments = Item.Attachments

[telepicker]

I think you were on to something with adding the count. I changed everything back to what I had working and added the count you mentioned.

Will see how that goes.


If TypeName(Item) = "MailItem" And _
Item.Attachments.Count > 0 Then
Set Msg = Item
Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Att

[telepicker]

BTW - so far I did 4 "self-test" emails and it has not thrown the error. So we will see.

:thumb

[BrianMH]

You don't want

myAttachments.Item(1).SaveAsFile attPath & Att

before your second if statement.

If you copy my code from post 60 exactly and just adjust the paths, senders and subjects you shouldn't have any problems. I'm suprised its not failing on that line since you haven't defined the attpath unless you defined that before. If you have then your probably saving it in 2 locations.

[telepicker]

Hmm - ok I will revise in the morning when I get in. The path is not defined anywhere other than in the individual IF statements, I will check to see if the files have been saving other locations as well. Thanks!