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!

Thanks for your time,

Regards:

G

[JP2112]

G,

Please use code tags when posting code.

[vba]your code goes here[/vba]

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,

[vba]
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
[/vba]

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.

[vba]
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
[/vba]

[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.

[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

[VBA]
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
[/VBA]
or you could nest case statements.

[JP2112]

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

[vba]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
[/vba]

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.

[vba]
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
[/vba]

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

[vba]

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\"

[/vba]

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?

[vba]

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

[/vba]


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:

[vba]
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

[/vba]

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

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


[VBA]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 [/VBA]

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:

[vba]
myAttachments.Item(1).SaveAsFile attPath & Att
[/vba]

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]

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:

[vba]
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

[/vba]

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

[telepicker]

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

myAttachments.Item(1).SaveAsFile attPath & Att

[/vba]