[RESOLVED] ** MailItem in Outlook

[charlie79]

I have the following code that will move all messages from the Inbox to a folder the user selects from the "Select Folder" dialog box:

Sub LAC_MoveMail()

Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim ca As MailItem
Dim myNewFolder As MAPIFolder

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)

Set myNewFolder = ns.PickFolder
Set ca = Inbox.Items.GetFirst

While TypeName(ca) <> "Nothing"
    ca.Move myNewFolder
    Set ca = Inbox.Items.GetNext
Wend

Set ca = Inbox.Items.GetLast
ca.Move myNewFolder

End Sub

Problem? When there is a meeting request in the users inbox, they get a run-time error - Type Mismatch. It's occuring on the

set ca = inbox.items.getnext

because ca is a MailItem Object. My question? How do I determine what type of objects are in the Inbox?

[RobDog888]

Try this. It will move only MailItems. You can add more to it to
handel other types.

Private Sub LAC_MoveMail_Click()
 
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim ca As MailItem
    Dim myNewFolder As MAPIFolder
    Dim i As Integer
    
    MousePointer = vbHourglass
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    
ReSelect:
    Set myNewFolder = ns.PickFolder
    If TypeName(myNewFolder) = "Nothing" Then
        MousePointer = vbNormal
        GoTo No_Bugs_Exit
    End If
    If myNewFolder.DefaultItemType <> olMailItem Then
        If MsgBox("Select Outlook MailItem type only!", vbOKCancel + vbInformation, App.ProductName) = vbOK Then
            GoTo ReSelect
        Else
            GoTo No_Bugs_Exit
        End If
    End If
    For i = Inbox.Items.Count To 1 Step -1
        If Inbox.Items.Item(i).Class = olMail Then
            Set ca = Inbox.Items.Item(i)
            ca.Move myNewFolder
        End If
        Set ca = Nothing
    Next
    MousePointer = vbNormal
 
No_Bugs_Exit:
    Set ns = Nothing
    Set myNewFolder = Nothing
 
End Sub