November 24th, 2003, 05:27 AM
|
|
Contributing User
|
|
Join Date: Oct 2002
Posts: 90
Time spent in forums: 6 m 30 sec
Reputation Power: 6
|
|
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 = "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
|
Dev Shed Forums Sponsor:
Del.icio.us
Digg
Google
Spurl
Blink
Furl
Simpy
Y! MyWeb
Linear Mode
