VBA: My Outlook VBA rule code does't work :(

[gicio]

Hi!!!

I write some VBA code that doesn't work good.
what the code SHOULD do:

After the send/receive proces the code loop through all messages in the inbox
and move the messages in the right folders (depend on the sender email address).

the problem is that after 3 loops I got a :

Run-time error '13': Type mismatch.


can someone tell me why I get this error?

Option Explicit


    Private Sub Application_NewMail()
        Dim currentNameSpace As NameSpace
        Dim currentMAPIFolder As MAPIFolder
        Dim currentMailItem As MailItem

        Set currentNameSpace = Application.GetNamespace("MAPI")
        Set currentMAPIFolder = currentNameSpace.GetDefaultFolder(olFolderInbox)

        For Each currentMailItem In currentMAPIFolder.Items

            'GotDotNet_Community@ microsoft.com
            If currentMailItem.SenderEmailAddress = "GotDotNet_Community@microsoft.com" Then
                Call MoveMail(currentMailItem, currentMAPIFolder.Folders.Item("Forum").Folders.Item("GotDotNet").EntryID)
            'newsalerts-noreply@google.com
            ElseIf currentMailItem.SenderEmailAddress = "newsalerts-noreply@google.com" Then
                Call MoveMail(currentMailItem, currentMAPIFolder.Folders.Item("News").Folders.Item("Google.com").EntryID)
            'newsmail@derStandard.at
            ElseIf currentMailItem.SenderEmailAddress = "newsmail@derStandard.at" Then
                Call MoveMail(currentMailItem, currentMAPIFolder.Folders.Item("Newsletter").Folders.Item("DerStandard.at").EntryID)

            Else

            End If

        Next currentMailItem

        Set currentMAPIFolder = Nothing
        Set currentNameSpace = Nothing
    End Sub


    Private Function MoveMail(currentMailItem As MailItem, strTargFldrID As String) As Boolean
        Dim currentNameSpace As NameSpace
        Dim currentMoveMailItem As MailItem

        Set currentNameSpace = Application.GetNamespace("MAPI")

        On Error GoTo FINISH:
        Set currentMoveMailItem = currentMailItem.Copy
        currentMoveMailItem.Move Destfldr:=currentNameSpace.GetFolderFromID(strTargFldrID)
        currentMailItem.Delete
FINISH:
        MoveMail = CBool(Err.Number)
    End Function

[Hrqls]

i never used vba in outlook .. but maybe the items in the mapifolder arent all mailitems .. maybe there are some subfolders as well ?

have a look at the items which your loop encounters .. if there is a 'item' which is in fact a folder .. then you have to loop through that out as well
(you could do this recursively)