[RESOLVED] Cannot move emails

[tommygrayson]

Hi guys!!!



Need help. Cannot move e-mail to folder. Don't know why.

Dim OrganizerApplication As New Outlook.Application
    Dim OrganizerNS As Outlook.NameSpace
    Dim OrganizerFolder As Outlook.Folders
    Dim DestFolder As MAPIFolder
    Dim InboxItem As Outlook.MailItem
    Dim InboxCount As Integer
    Dim DestFolderCount As Integer
    Dim Sender As String
    Dim CompareFolder As String
    Set OrganizerNS = OrganizerApplication.GetNamespace("MAPI")
    Set OrganizerFolder = OrganizerNS.Folders.Item("Mailbox - Ian Eco (DHL PH)").Folders
    Set DestFolder = OrganizerNS.Folders.Item("IAN Personal")
    InboxCount = 1
    Do While Not InboxCount = OrganizerFolder.Item(2).Items.Count
        On Error Resume Next
        Set InboxItem = OrganizerFolder.Item(2).Items.Item(InboxCount)
        If Err = 13 Then
        Else
            Sender = InboxItem.SenderEmailAddress
            DestFolderCount = 1
            Do While Not DestFolderCount = DestFolder.Folders.Count + 1
                CompareFolder = Replace(DestFolder.Folders.Item(DestFolderCount), " ", ".")
                If InStr(1, Sender, UCase(CompareFolder)) > 0 Then
                    InboxItem.Move (DestFolder)
                End If
                DestFolderCount = DestFolderCount + 1
            Loop
        End If
        Err = 0
        InboxCount = InboxCount + 1
    Loop