• We’re currently investigating an issue related to the forum theme and styling that is impacting page layout and visual formatting. The problem has been identified, and we are actively working on a resolution. There is no impact to user data or functionality, this is strictly a front-end display issue. We’ll post an update once the fix has been deployed. Thanks for your patience while we get this sorted.

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

gicio

Member
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?







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
 
if i am not mistaken outlook's vba should also have a 'debug' button after an error is created, if you click it, it "should" take you to the line with the error, if you can find out which line is causing the program maybe we can better help you discover the issue, it looks ok as is but my knowledge of outlook vba is a little limited so i could be missing it.
 
Back
Top