Outlook macro to sort incoming emails based on attachment type

[Gus1987]

Hello,

Ive been trying to find a macro that will move emails with xls or xlsx attachments into a subfolder of the inbox called Spreadsheets.

I have multiple mailboxes and only want this to run on a single mailbox, so I believe using a rule to run a script on a specific inbox is the best way to go. Ive enabled the option but editing the registry so I can select the "run a script" rule, but the examples I have found online all give me various errors and im nowhere near experienced enough to resolve the issue.

This is the code I currently have, amended from an example I found online:


Sub MercedesExcel2(item As Outlook.MailItem)


Dim olkAtt As Outlook.Attachment
'Check each attachment
For Each olkAtt In item.Attachments
'If the attachment's file name ends with .xls or xlsx
If Right(LCase(olkAtt.FileName), 5) = ".xlsx" Then
'Move the message to Spreadsheets folder
item.Move Session.GetDefaultFolder(olFolderInbox).Folders("Spreadsheets")

ElseIf Right(LCase(olkAtt.FileName), 4) = ".xls" Then

item.Move Session.GetDefaultFolder(olFolderInbox).Folders("Spreadsheets")

Exit For
End If
Next
Set olkAtt = Nothing






End Sub





When I receive an email with the specified attachments, I get an object cannot be found error and it highlights the line:

item.Move Session.GetDefaultFolder(olFolderInbox).Folders("Spreadsheets")

Im not sure what is wrong with it, as the folder does exist as a subfolder of the inbox.


Any help would be much appreciated.

Thanks

Steve

[gmayor]

Try the following, which has a little more error handling and which will create the folder if it is found to be missing.

Sub MercedesExcel2(item As Outlook.MailItem)
'Graham Mayor - http://www.gmayor.com - Last updated - 27 Feb 2018
Dim olkAtt As Outlook.Attachment
Dim strExt As String
Dim olFolder As Outlook.Folder
Dim bFound As Boolean
For Each olFolder In Session.GetDefaultFolder(olFolderInbox).folders
If LCase(olFolder.Name) = "spreadsheets" Then
bFound = True
Exit For
End If
Next olFolder
If Not bFound Then
Set olFolder = Session.GetDefaultFolder(olFolderInbox).folders.Add("Spreadsheets")
End If

'Check each attachment
If item.Attachments.Count > 0 Then
For Each olkAtt In item.Attachments
strExt = Mid(olkAtt.fileName, InStrRev(olkAtt.fileName, Chr(46)))
'If the attachment's file name ends with .xls or xlsx
If LCase(strExt) = ".xls" Or LCase(strExt) = ".xlsx" Then
item.Move olFolder
Exit For
End If
Next olkAtt
End If
lbl_Exit:
Set olkAtt = Nothing
Set olFolder = Nothing
Exit Sub
End Sub

[Gus1987]

Thank you Graham, this moves the emails however it seems to move them to a subfolder of a different mail account. The account I want to run this on is not the default account setup in outlook, so would I need to specify the account (store?) so it uses the Spreadsheets subfolder of the specific inbox?

[Gus1987]

I have this set up as a rule to run when an email arrives, but it creates a Spreadsheets subfolder on a different mail account in Outlook and moves the spreadsheets there.

How can I specify what mailbox the "spreadsheets" subfolder should be located in? The outlook application that will run this macro has dozens of outlook accounts and I cant let anything get mixed up.

[gmayor]

The following should hopefully address the sub folder of the Inbox into which the message arrives, based on the account. If not then without access to your system, which would not be practical, I regret I cannot help further.


Sub MercedesExcel2(item As Outlook.MailItem)
'Graham Mayor - http://www.gmayor.com - Last updated - 27 Feb 2018
Dim olkAtt As Outlook.Attachment
Dim strExt As String
Dim olFolder As Outlook.Folder
Dim bFound As Boolean
Dim olRoot As Object

Set olRoot = item.Parent
For Each olFolder In olRoot.folders
If LCase(olFolder.Name) = "spreadsheets" Then
bFound = True
Exit For
End If
Next olFolder
If Not bFound Then
Set olFolder = olRoot.folders.Add("Spreadsheets")
End If

'Check each attachment
If item.Attachments.Count > 0 Then
For Each olkAtt In item.Attachments
strExt = Mid(olkAtt.fileName, InStrRev(olkAtt.fileName, Chr(46)))
'If the attachment's file name ends with .xls or xlsx
If LCase(strExt) = ".xls" Or LCase(strExt) = ".xlsx" Then
item.Move olFolder
Exit For
End If
Next olkAtt
End If
lbl_Exit:
Set olkAtt = Nothing
Set olFolder = Nothing
Exit Sub
End Sub

[Gus1987]

Hi Graham, thanks again for your help but im getting the same issue, it seems to add the folder to a different mail account and moves the email there.

Im trying to learn at the same time, where it says:




Set olRoot = item.Parent


Is this telling the macro to only use the account that the email arrived in? Would it help if I specified the actual account (store?) so its forced to only check that account for the subfolder?

[Gus1987]

I think I have got it to work!

I noticed in your code that the only time the olFolder is set is if the folder is missing, so I guessed the issue was somewhere in the check to see if the folder existed. I removed this check as the folder will always exist on this mailbox.
I kept the olRoot and then defined olFolder as olroot.Folders("Spreadsheets") and that appears to have done the trick.

The full code I am using is now here:




Sub MercedesExcel4(item As Outlook.MailItem)


Dim olkAtt As Outlook.Attachment
Dim strExt As String
Dim olFolder As Outlook.Folder
Dim bFound As Boolean
Dim olRoot As Object

Set olRoot = item.Parent
Set olFolder = olRoot.Folders("Spreadsheets")


'Check each attachment
If item.Attachments.Count > 0 Then
For Each olkAtt In item.Attachments
strExt = Mid(olkAtt.FileName, InStrRev(olkAtt.FileName, Chr(46)))
'If the attachment's file name ends with .xls or xlsx
If LCase(strExt) = ".xls" Or LCase(strExt) = ".xlsx" Then
item.Move olFolder
Exit For
End If
Next olkAtt
End If
lbl_Exit:
Set olkAtt = Nothing
Set olFolder = Nothing
Exit Sub
End Sub





I just want to thank you again Graham, I wouldnt have been able to get this to work without your help!

Im not sure what was wrong with my original code, my guess is that it was trying to check for the folder in the different mailbox which is why I was getting an object not found error?