170 copys after move using Entry and Store ID

Hi. Now I have riddle.

I use object events to save Entry and Store ID. This object i want move to define folder after close.

Private WithEvents oOtwartyItem As Outlook.MailItem
Dim strEntryID$, strStoreID$

Private Sub Application_ItemLoad(ByVal item As Object)
    If item.Class = olMail Then Set oOtwartyItem = item
End Sub

Private Sub oOtwartyItem_Close(Cancel As Boolean)
    If oOtwartyItem.UnRead = False Then
        strEntryID = oOtwartyItem.EntryID
        strStoreID = oOtwartyItem.Parent.StoreID
    End If
End Sub

Private Sub oOtwartyItem_Unload()
Dim oFolder As MAPIFolder, objItem As Object, objMovedItem As Object
Dim objNS As NameSpace
    Set objNS = Application.GetNamespace("MAPI")
    Set oFolder = objNS.Folders("Foldery osobiste") _
                       .Folders("testowy") 'some sub folder
    'On Error Resume Next 'without is an error 8004010f "I can't find value" but after accept still works
    Set objItem = objNS.GetItemFromID(strEntryID, strStoreID)
    'Set objMovedItem = objItem.Move(oFolder) 'or
     objItem.Move oFolder
     'I'v got 170 copies of oOtwartyItem, in oFolder why?, and from direct folder message dispirited!
End Sub

Oskar Shon, Office System MVP

Press if Helpful; Answer when a problem solved