Ok, so I had some issues with the internal Outlook rules for moving emails as they arrive to appropriate folders so I wrote a small VBA module to do it for me.
Here is how it works:
- When new emails arrives, an event is run for each new mail.
- The VBA script looks at the senders address and tries to look up the address in a selection of contact folders. One contact folder contains all the addresses of senders for a specific mail folder (ie Contact folder 'Work' will hold the addresses of senders who need their mails put into the 'Work' mail folder.)
- If the script finds the address it looks at the contact folders name and then moves it to its specific mail folder.
- If the script cannot find the senders address in any of the contacts folders, it will display a form to the user with a list of the available mail folders to which all future mails will be moved to. (Upon selection, the script adds the senders address to the appropriate contacts folder and then moves the mail as normal)
- The script then finishes and is then re-run for the next new email via the outlook rule
When the VBA script was initially written, it worked exactly as planned and would move mail around without any issues.
Since then SP2 for outlook was released and my outlook updated. Ever since, the script would never run when outlook was initially opened and would continue to not run until I manually run the rule on all mail in my Inbox. After this it will run on each new email as it arrives as it should do.
My question is what on earth could possibly be causing this to function like this? Is it my code or something within Outlook that's not right?
I have pretty extensive knowledge when it comes to VBA with Access but not quite so much with Outlook, none the less my gut feeling is that its not the VBA code at fault but something else. But what?
Here is the code/VBA script used to move my mail around (this is the procedure that is called directly by the Outlook rule for each email):
'This sub is called by a Rule which runs for each new email received through a specified account
Sub ProcessNewMail(objItem As Outlook.MailItem)
Dim objNameSpace As Outlook.NameSpace
Dim objFolder As Outlook.Folder
Dim objSubFolder As Outlook.Folder
Dim curSender As String
Dim MoveTo As String
Set objNameSpace = Application.GetNamespace("MAPI")
Set objFolder = objNameSpace.GetDefaultFolder(olFolderInbox)
'Get the senders email address fo the current email
curSender = objItem.SenderEmailAddress
' 'DEBUGGING
' WriteToLog "C:\Logs\MailProcessing.txt", Date & Chr(9) & Time & Chr(9) & "Processing - " & curSender
'Get the folder name for the email to be moved to
MoveTo = GetSendersMailFolder(curSender)
'Check that a folder has actually been returned before trying to move the email
If MoveTo <> "" Then
' 'DEBUGGING
' WriteToLog "C:\Logs\MailProcessing.txt", Date & Chr(9) & Time & Chr(9) & " Folder Found - " & MoveTo
'If the folder is not the inbox then
If MoveTo <> "Inbox" Then
' 'DEBUGGING
' WriteToLog "C:\Logs\MailProcessing.txt", Date & Chr(9) & Time & Chr(9) & " Folder Checked (INBOX)"
Set objSubFolder = objFolder.Folders.Item(MoveTo)
'Move the Mail Item to the required folder
objItem.Move objSubFolder
' 'DEBUGGING
' WriteToLog "C:\Logs\MailProcessing.txt", Date & Chr(9) & Time & Chr(9) & " Email Moved"
End If
Else
' 'DEBUGGING
' WriteToLog "C:\Logs\MailProcessing.txt", Date & Chr(9) & Time & Chr(9) & " Folder Not Found"
'Ask the user where to move the current folder to - This is just calling a form and passing the selected folderback....nothing complicated
MoveTo = SelectFolder(curSender, objItem.Subject)
' 'DEBUGGING
' WriteToLog "C:\Logs\MailProcessing.txt", Date & Chr(9) & Time & Chr(9) & " Folder Selected - " & MoveTo
'If the selected folder is the inbox then
If MoveTo <> "Inbox" Then
Set objSubFolder = objFolder.Folders.Item(MoveTo)
'Move the eMail to the users selected folder
objItem.Move objSubFolder
End If
' 'DEBUGGING
' WriteToLog "C:\Logs\MailProcessing.txt", Date & Chr(9) & Time & Chr(9) & " Adding Sender To Address List - " & MoveTo
'Also Add the senders email address to the Address List for the selected folder
Call AddEmailToAddressList(curSender, MoveTo)
End If
' 'DEBUGGING
' WriteToLog "C:\Logs\MailProcessing.txt", ""
End Sub
Here is the procedure to get the senders mail folder:
'Gets the Folder name where the all mail from the supplied senders address is put
Function GetSendersMailFolder(MailSender As String) As String
Dim objNameSpace As Outlook.NameSpace
Dim objAddressList As Outlook.AddressList
Dim objAddressEntry As Outlook.AddressEntry
Set objNameSpace = Application.GetNamespace("MAPI")
'Loop through all of the Address Lists
For Each objAddressList In objNameSpace.AddressLists
'Loop through all Contacts in the current Address List
For Each objAddressEntry In objAddressList.AddressEntries
'Check if the Senders Address is in the current address entry (Not case sensitive)
If (LCase(objAddressEntry.Address) = LCase(MailSender)) Then
'Return the Folder in which the senders emails must be placed
GetSendersMailFolder = objAddressList.Name
'Exit the function
Exit Function
End If
'Move to the next Contact in the current Address List
Next objAddressEntry
'Move to the next Address List
Next objAddressList
'If you get to this point, the address is not in the AddressLists, so return nothing
GetSendersMailFolder = ""
End Function