I’m writing Outllok macro that moves sent email to specyfic folders.
Sub is working fine and it is doing the job however after Sub I’m receiving error that “Operation can’t be done, because object has been removed”.
I think that the Outlook is trying to move email to Sent email folder but there is none.
But that is my quess – maybe You can help to remove this prompt?

Code for Sub:

Private Sub Application_ItemSend(ByVal objItem As Object, Cancel As Boolean)
Dim mail As MailItem
Dim szukane As String
Dim linijek As Integer
Dim adres As String
Dim MyArr() As String
Dim folder As String
Dim myDestFolder As Outlook.folder
Dim myDestFolder1 As Outlook.folder
Dim folderGlowny As Outlook.folder
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.folder
Dim myOutbox As Outlook.folder
Dim myItems As Outlook.Items
Dim myItem As Object

adres = "C:Skryptyadresy.txt"


Const ForAppending = 8
Set Fso = CreateObject("Scripting.FileSystemObject")
Set theFile = Fso.OpenTextFile(adres, ForAppending, Create:=True)
linijek = theFile.Line
Set Fso = Nothing

ReDim Preserve MyArr(linijek, 2)
Dim FileNum As Integer
Dim DataLine As String
Dim i As Integer
i = 1
FileNum = FreeFile()
Open adres For Input As #FileNum
While Not EOF(FileNum)
    Line Input #FileNum, DataLine
    MyArr(i, 1) = Split(DataLine, ";")(0)
    MyArr(i, 2) = Split(DataLine, ";")(1)
    i = i + 1
Wend
        
If TypeName(objItem) = "MailItem" Then
    Set mail = objItem
    Dim odbiorca As Recipient

    Set odbiorca = mail.Recipients(1)
   
    For i = 1 To linijek
        If MyArr(i, 1) = odbiorca.Address Then
            folder = MyArr(i, 2)
            Exit For
        End If
    Next
End If
' przenoszenie maila do folderu
If folder <> "Nothing" Then
    Dim znaleziono As Boolean
    znaleziono = False
    Set myNameSpace = Application.GetNamespace("MAPI")
    Set myDestFolder = myNameSpace.Folders(1)
    Set myOutbox = myNameSpace.GetDefaultFolder(olFolderSentMail)
    
    For Each myDestFolder1 In myDestFolder.Folders
        If myDestFolder1.Name = "Korespondencja" Then
            Set folderGlowny = myDestFolder1
            Exit For
        End If
    Next
    'Szukanie w głównych folderach
    For Each myDestFolder1 In folderGlowny.Folders
        If meDestFolder1 = folder Then
            'przenieść maila tutaj
            mail.Move meDestFolder1
            znaleziono = True
            Exit For
        End If
    Next
    'Jeżeli w głównych brak tego folderu to przeglądamy podfoldery
    Dim podFolder As Outlook.folder
    
    
    For Each myDestFolder1 In folderGlowny.Folders
        If myDestFolder1.Folders.Count > 0 Then
            For Each podFolder In myDestFolder1.Folders
                If podFolder.Name = folder Then
                    mail.Move podFolder
                    znaleziono = True
                    Exit For
                End If
            Next
        End If
        If znaleziono Then
            Exit For
        End If
    Next
    If Not znaleziono Then
        MsgBox ("Nie znaleziono folderu " & folder)
    End If
End If

End Sub