Solved

How do I automatically save .xlsm email attachments that come to a shared public folder with a specified subject line?

Posted on 2015-01-05
21
479 Views
Last Modified: 2015-01-11
What we need is code that will automatically save *.xlsm attachments on emails with "Specific Subject" on the subject line, then archive the email to another folder (in that shared account) so it's not in the way.  I have some code that will automatically save all *.xlsm attachments, and other code that will save all attachments on manually selected emails.  Some kind of hybrid code would be the ticket.  I am not the owner of the account, so I cannot set rules to it. Hopefully, this module could be exported to two or three other users who also have access to this account.

I'm not that experienced in VBA overall, and more of an Access VBA guy, so the Outlook aspect has me even more in the dark.  Since these Excel attachments will ultimately be imported and processed in Access anyway, the very best solution would be to run Access code that finds the incoming email attachments and imports a range directly from them.

You can see I'm not even sure what I should be shooting for.  Any pointers would be greatly appreciated!
0
Comment
Question by:Jay Williams
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 12
  • 7
  • 2
21 Comments
 
LVL 35

Assisted Solution

by:Kimputer
Kimputer earned 500 total points
ID: 40531567
For me, it would look like this (simple version, expects the email with that subject to have 1 file attachment). I assume that it's from an automated system and you usually never get an email with that subject and NOT have an attachment.
Of course, further programming can be done to have better error handling:

Public WithEvents myItems As Outlook.Items

Public Sub Application_Startup()

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

    On Error GoTo notfoundFolder
    Set myItems = myNameSpace.Folders("Public Folder").Folders("public mailbox").Items  'edit!
    On Error GoTo 0

    Exit Sub

notfoundFolder:
    MsgBox "Unable to find folder"

End Sub


Private Sub myItems_ItemAdd(ByVal Item As Object)

    Dim moveFolder As Outlook.MAPIFolder
    If TypeName(Item) = "MailItem" Then
	
		If Item.Subject = "Specific Subject" and LCase(Right(Item.Attachments.Item(1).FileName, 5)) = ".xlsm" then 'edit subject!
				Item.Attachments.Item(1).SaveAsFile "C:\attachments\" & Item.Attachments.Item(1).FileName
			   On Error GoTo notfoundFolder
			   Set moveFolder = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("moved xlms file") 'edit!
			   On Error GoTo 0
				
			   Item.Move moveFolder
		End if

    End If

    Exit Sub

notfoundFolder:
    MsgBox "Unable to find folder"
End Sub

Open in new window



Look for the "edit" comments, you need to adjust it to your own situation.
0
 

Author Comment

by:Jay Williams
ID: 40531577
Thank you my friend! I'll give it a whirl.
0
 

Author Comment

by:Jay Williams
ID: 40531622
I haven't tested this yet, but had some questions (commented).

Public WithEvents myItems As Outlook.Items 'Why is this showing red? Looks angry!

Public Sub Application_Startup()

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

    On Error GoTo notfoundFolder
    Set myItems = myNameSpace.Folders("XE_IPP").Folders("Inbox").Items  'Guessing on this.
    On Error GoTo 0

    Exit Sub

notfoundFolder:
    MsgBox "Unable to find folder"

End Sub


Private Sub myItems_ItemAdd(ByVal Item As Object)

    Dim moveFolder As Outlook.MAPIFolder
    If TypeName(Item) = "MailItem" Then
    
        If Item.Subject = "Specific Subject" And LCase(Right(Item.Attachments.Item(1).FileName, 5)) = ".xlsm" Then 'I think I got this edit right.
                Item.Attachments.Item(1).SaveAsFile "G:\XE_ECMs\IPP Sharing Development\New Requests" & Item.Attachments.Item(1).FileName
               On Error GoTo notfoundFolder
               Set moveFolder = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("Requests") '"Requests" is a subfolder of the XE_IPP Inbox. Is this right?!
               On Error GoTo 0
                
               Item.Move moveFolder
        End If

    End If

    Exit Sub

notfoundFolder:
    MsgBox "Unable to find folder"
End Sub

Open in new window

0
Salesforce Has Never Been Easier

Improve and reinforce salesforce training & adoption using WalkMe's digital adoption platform. Start saving on costly employee training by creating fast intuitive Walk-Thrus for Salesforce. Claim your Free Account Now

 
LVL 35

Assisted Solution

by:Kimputer
Kimputer earned 500 total points
ID: 40531653
Public WithEvents myItems As Outlook.Items 'Why is this showing red? Looks angry!
Not read in my Outlook. Did you use ALT+F11 in Outlook, did you put it in the ThisOutlookSession?

   Set myItems = myNameSpace.Folders("XE_IPP").Folders("Inbox").Items  'Guessing on this.

This would be correct if you are another user, and you had XE_IPP added to your Outlook (and had access to it). But I thought you said it was a Public folder?

     If Item.Subject = "Specific Subject" And LCase(Right(Item.Attachments.Item(1).FileName, 5)) = ".xlsm" Then 'I think I got this edit right.
Seems a bit weird, but if you're sure the subject is in fact "Specific Subject", who am I to argue?


Set moveFolder = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("Requests") '"Requests" is a subfolder of the XE_IPP Inbox. Is this right?!

Open in new window

This is the Request folder of the actual user with that Outlook code. If the user is in fact already XE_IPP, it is correct, it's the XE_IPP > Inbox > Requests folder
If you are logged in as John, it is in fact the John > Inbox > Requests folder
0
 

Author Comment

by:Jay Williams
ID: 40531669
OK, you're about to find out how green I am.

1. No, I didn't put it in ThisOutlookSession, I put it in it's own module, because I thought it could be more easily shared with my collaborators.  I can get it to them either way.  I know it's hard to believe, but they actually know less about this stuff than I do. :-)

2. Maybe I don't know what a public folder is. I guess it's a shared folder, not public. XE_IPP shows on my Outlook.

3. I did actually put in the right subject--after I sent it back to you.

I guess all I really have to do is put it in ThisOutlookSession instead of it's own module?
0
 
LVL 84
ID: 40531675
Are you doing this from Access? Or from Outlook?

If you're doing this from Access, you'll have to add a Reference to the Outlook library in Access. To do that, open the VBA Editor, click Tools - References, and locate the "Microsoft xx Object Library", where "xx" is the version of Outlook you're running. That should clear up the "red" line in your code.
0
 

Author Comment

by:Jay Williams
ID: 40531682
For now, I'm doing it from Outlook, but I'll keep that in mind. Thanks for your time and patience!
0
 
LVL 84
ID: 40531700
Okay - in the future, be sure to add your question to the right Zone. You included this in the Access zone only, and you really should have put it into the Office and Outlook zones.
0
 

Author Comment

by:Jay Williams
ID: 40531722
Thanks. Besides being brand new, I'm clearly Zoned Out.  I didn't even see the Office or Outlook zones.  I'll have to look out for Outlook.

You're the first one to help me on Ex Ex, and I really do appreciate your help, patience and kindness. I'll let you know how this pans out.
0
 

Author Comment

by:Jay Williams
ID: 40531771
I did put the code in ThisOutlookSession. The macro didn't run on event.
My Outlook view of XE_IPP Inbox
0
 

Assisted Solution

by:Jay Williams
Jay Williams earned 0 total points
ID: 40531792
Here is what's in ThisOutlookSession:

Public WithEvents myItems As Outlook.Items
Public Sub Application_Startup()

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

    On Error GoTo notfoundFolder
    Set myItems = myNameSpace.Folders("XE_IPP").Folders("Inbox").Items
    On Error GoTo 0

    Exit Sub

notfoundFolder:
    MsgBox "Unable to find folder"

End Sub


Private Sub myItems_ItemAdd(ByVal Item As Object)

    Dim moveFolder As Outlook.MAPIFolder
    If TypeName(Item) = "MailItem" Then
    
        If Item.Subject = "IPP Share Request" And LCase(Right(Item.Attachments.Item(1).FileName, 5)) = ".xlsm" Then
                Item.Attachments.Item(1).SaveAsFile "G:\XE_ECMs\IPP Sharing Development\New Requests" & Item.Attachments.Item(1).FileName
               On Error GoTo notfoundFolder
               Set moveFolder = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("Requests")
               On Error GoTo 0
                
               Item.Move moveFolder
        End If

    End If

    Exit Sub

notfoundFolder:
    MsgBox "Unable to find folder"
End Sub

Open in new window

0
 
LVL 35

Assisted Solution

by:Kimputer
Kimputer earned 500 total points
ID: 40533105
The fact that you DIDN'T get a "Unable to find folder" message suggests the first part (Application_Startup()) is working.
To be sure, I'm editing some stuff, purely from a debugging standpoint:

Public WithEvents myItems As Outlook.Items
Public Sub Application_Startup()

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

    On Error GoTo notfoundFolder
    Set myItems = myNameSpace.Folders("XE_IPP").Folders("Inbox").Items
	msgbox "test message: counting messages " & myItems.count 'this message truly means this part of the code is correct, if the number displayed is in fact the same amount as messages in the inbox
    On Error GoTo 0

    Exit Sub

notfoundFolder:
    MsgBox "Unable to find folder"

End Sub


Private Sub myItems_ItemAdd(ByVal Item As Object)
	
	
	Dim moveFolder As Outlook.MAPIFolder
    If TypeName(Item) = "MailItem" Then
		
		msgbox "message arrived in  this inbox with subject: " & Item.Subject 'yay, the event DID fire! Another step in the right direction!
		msgbox "attachment extension is " & LCase(Right(Item.Attachments.Item(1).FileName, 5))
        
		If Item.Subject = "IPP Share Request" And LCase(Right(Item.Attachments.Item(1).FileName, 5)) = ".xlsm" Then
				msgbox "Inside if loop" 'hopefully this will display, if not, check the two earlier msgboxes
                Item.Attachments.Item(1).SaveAsFile "G:\XE_ECMs\IPP Sharing Development\New Requests" & Item.Attachments.Item(1).FileName
               On Error GoTo notfoundFolder
               Set moveFolder = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("Requests")
               On Error GoTo 0
                
               Item.Move moveFolder
        End If

    End If

    Exit Sub

notfoundFolder:
    MsgBox "Unable to find folder"
End Sub

Open in new window


I'm pretty sure you can figure out what the messageboxes means, and what you should see. Please report back your findings.
For instance, the startup  should fire a message box with the message count. If not, we should focus there.
If successful though, we should wait for any message. It fires another 2 messageboxes. Good, that part works also. Now wait for a message you actually want and see if the "Inside if loop" message pops up. If so, it's only the few last lines that needs fixing.
0
 

Author Comment

by:Jay Williams
ID: 40533296
Good morning, and thank you!  Progress indeed! On start up, there was a message box that counted the files, and the count was correct, but nothing happened after that.  I did check to see that the attachments have the right extension.

Next, I sent another attachment and it did fire the message boxes, but the attachment did not save anywhere I can find it and the email did not move to the specified folder; both are "gone"--never actually saw the email or attachment.  Must be an issue with the destination folder designation?  Making sure I didn't "fat finger" something.

The two original test emails with attachments that were already in the inbox are still there untouched.  That will be an issue too; there will often be several items to be processed that come in on start up.
0
 
LVL 35

Assisted Solution

by:Kimputer
Kimputer earned 500 total points
ID: 40533369
I need to know the two messages upon arrival of a message you want.
I gather you never saw the "Inside if loop" message?

Also, this code is meant  for NEW arrivals WHILE Outlook is open.
If you want it to check your current folder, I need to append some startup code as well.
0
 

Author Comment

by:Jay Williams
ID: 40533391
I did see the "Inside if loop" message, but I don't understand what it means or what it is for.  Actually, unless the messages are needed for error handling or some other purpose I don't understand, I don't need them at all.

It's great to grab the new ones when they come in, but on start up, there may be a pile of them all at once that were sent overnight.  Ultimately, the whole folder of emails with .xlsm attachments needs to be cleaned out, When and how that happens is less important.
0
 
LVL 35

Assisted Solution

by:Kimputer
Kimputer earned 500 total points
ID: 40533403
As I said, I added the messages for debugging purposes and will be removed after the code is working.
Since you DID get the "Inside if loop" message, it automatically means you SHOULD:

NOT have the file in G:\XE_ECMs\IPP Sharing Development\New Requests since the code is missing a slash (if you noticed my original line was
"Item.Attachments.Item(1).SaveAsFile "C:\attachments\" & Item.Attachments.Item(1).FileName"
But the email SHOULD have been moved to YOUR OWN Inbox\Requests folder (also explained in earlier comment). because you didn't mention the "Unable to find folder" message.
0
 

Author Comment

by:Jay Williams
ID: 40533428
Gotcha. I did notice the save directory, and changed it to:

Item.Attachments.Item(1).SaveAsFile "G:\XE_ECMs\IPP Sharing Development\New Requests" & Item.Attachments.Item(1).FileName

Was that wrong?

That explains why the email didn't show; I have no "Requests" folder of my own.  It is a sub folder of the (shared) XE_IPP Inbox.  These emails and attachments will be kept until the requests are processed.
0
 
LVL 35

Accepted Solution

by:
Kimputer earned 500 total points
ID: 40533477
Item.Attachments.Item(1).SaveAsFile "G:\XE_ECMs\IPP Sharing Development\New Requests" & Item.Attachments.Item(1).FileName

should be

Item.Attachments.Item(1).SaveAsFile "G:\XE_ECMs\IPP Sharing Development\New Requests\" & Item.Attachments.Item(1).FileName

And this

 Set moveFolder = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("Requests")

should be

Set moveFolder = Application.GetNamespace("MAPI").Folders("XE_IPP").Folders("Inbox").Folders("Requests")

or (if errors):

Dim myNameSpace As Outlook.NameSpace
Set myNameSpace = Application.GetNamespace("MAPI")
Set moveFolder = myNameSpace.Folders("XE_IPP").Folders("Inbox").Folders("Requests")
0
 

Author Comment

by:Jay Williams
ID: 40533496
It worked perfectly (you knew it would)! Thanks.  Now, how do I go back and get the other ones and take out the messages?  Am I pressing my luck? :-)
0
 
LVL 35

Assisted Solution

by:Kimputer
Kimputer earned 500 total points
ID: 40533527
No, replace only the startup code:

Public Sub Application_Startup()

    Dim oMail As Outlook.MailItem
    Dim myNameSpace As Outlook.NameSpace
    Set myNameSpace = Application.GetNamespace("MAPI")

    On Error GoTo notfoundFolder
    Set myItems = myNameSpace.Folders("XE_IPP").Folders("Inbox").Items

	For Each oMail In myItems
		If TypeName(oMail) = "MailItem" Then
			If oMail.Subject = "IPP Share Request" And LCase(Right(oMail.Attachments.Item(1).FileName, 5)) = ".xlsm" Then
				   oMail.Attachments.Item(1).SaveAsFile "G:\XE_ECMs\IPP Sharing Development\New Requests" & oMail.Attachments.Item(1).FileName
				   Set moveFolder = myNameSpace.Folders("XE_IPP").Folders("Inbox").Folders("Requests")
				   oMail.Move moveFolder
			End If
		End If
    Next
		
    On Error GoTo 0

    Exit Sub

notfoundFolder:
    MsgBox "Unable to find folder"

End Sub

Open in new window


Obviously, remove or comment out the messagebox commands in the rest of the code.
0
 

Author Closing Comment

by:Jay Williams
ID: 40542867
This is an example of a very kind and qualified teacher patiently bringing a newbie along.  This was not a difficult problem for someone who knows a solution.  The biggest challenge was dragging what was needed out of me.  Kudos and thanks!
0

Featured Post

SharePoint Admin?

Enable Your Employees To Focus On The Core With Intuitive Onscreen Guidance That is With You At The Moment of Need.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes two methods for creating a combo box that can be used to add new items to the row source -- one for simple lookup tables, and one for a more complex row source where the new item needs data for several fields.
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
Familiarize people with the process of utilizing SQL Server views from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Access…
Familiarize people with the process of utilizing SQL Server functions from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Ac…

730 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question