Carson89 0 Newbie Poster

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:

  1. When new emails arrives, an event is run for each new mail.
  2. 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.)
  3. If the script finds the address it looks at the contact folders name and then moves it to its specific mail folder.
  4. 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)
  5. 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
Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.