G
Guest
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 =
"(e-mail address removed)" Then
Call MoveMail(currentMailItem,
currentMAPIFolder.Folders.Item("Forum").Folders.Item("GotDotNet").EntryID)
'(e-mail address removed)
ElseIf currentMailItem.SenderEmailAddress =
"(e-mail address removed)" Then
Call MoveMail(currentMailItem,
currentMAPIFolder.Folders.Item("News").Folders.Item("Google.com").EntryID)
'(e-mail address removed)
ElseIf currentMailItem.SenderEmailAddress =
"(e-mail address removed)" 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
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 =
"(e-mail address removed)" Then
Call MoveMail(currentMailItem,
currentMAPIFolder.Folders.Item("Forum").Folders.Item("GotDotNet").EntryID)
'(e-mail address removed)
ElseIf currentMailItem.SenderEmailAddress =
"(e-mail address removed)" Then
Call MoveMail(currentMailItem,
currentMAPIFolder.Folders.Item("News").Folders.Item("Google.com").EntryID)
'(e-mail address removed)
ElseIf currentMailItem.SenderEmailAddress =
"(e-mail address removed)" 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