Hi!!!
I write some VBA code that doesn't work good.
what the code SHOULDdo:
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




do:
Reply With Quote