Results 1 to 2 of 2

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

  1. #1

    Thread Starter
    Member
    Join Date
    Oct 2002
    Posts
    51

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

    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?






    Code:
    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 = "[email protected]" Then
                    Call MoveMail(currentMailItem, currentMAPIFolder.Folders.Item("Forum").Folders.Item("GotDotNet").EntryID)
                '[email protected]
                ElseIf currentMailItem.SenderEmailAddress = "[email protected]" Then
                    Call MoveMail(currentMailItem, currentMAPIFolder.Folders.Item("News").Folders.Item("Google.com").EntryID)
                '[email protected]
                ElseIf currentMailItem.SenderEmailAddress = "[email protected]" 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

  2. #2
    Hyperactive Member Granty's Avatar
    Join Date
    Mar 2001
    Location
    London
    Posts
    439
    Which line errors?

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width