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
