Auto Save Attachments from multiple senders

[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

[vba]msg.subject like "*test2*" [/vba] or
[vba]trim(msg.subject) = "test2"[/vba]

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

[vba]
Att = myAttachments.Item(1).DisplayName
[/vba]

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

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


[/vba]

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

[VBA]ElseIf Msg.SenderEmailAddress = another@gmail.com And Msg.Subject = "Test3" Then[/VBA]
needs to be [VBA]ElseIf Msg.SenderEmailAddress = "another@gmail.com" And Msg.Subject = "Test3" Then[/VBA]
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!

[BrianMH]

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


[/vba]
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
[vba]
ElseIf Msg.Sender = "someoneelse@ltr.com" And Msg.Subject = "Test2" Then
attPath = "G:\Daily \Test\UMTA Report\"
boolDownload = True
[/vba]

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.

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

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

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

[/vba]

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

[vba]

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


[/vba]

[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
[vba]attPath = "G:\Daily\Test\uncategorized\"[/vba] put
[vba]goto ProgramExit[/vba]

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


Gcomyn

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

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

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

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

[vba]

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

[/vba]

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