Access + Outlook: move emails interrupts vba code

[alexbeatle]

Good day,
The following interrupts code execution once in a while.
It basically moves email to the "Imported" folder and a subfolder with the month and year the email was received.

This part is general setup of outlook, and creation of
strDestMoveFolder = "Imported" if required

Set appOutlook = GetObject(, "Outlook.Application")
If Err <> 0 Then
    ' Attempt to start outlook
    ' Can be used to start a second instance of outlook
    Set appOutlook = CreateObject("Outlook.Application")
End If
Set namespaceOutlook = appOutlook.GetNamespace("MAPI")
 
'search for the object with name <strTargetEmail>
For Count = 1 To namespaceOutlook.Folders.Count
If LCase(namespaceOutlook.Folders.Item(Count).Name) = LCase(strTargetEmail) Then
    Set objOutlookAddress = namespaceOutlook.Folders.Item(Count)
    Exit For
    End If
Next
'search for the folder <strTargetFolder> inside of that object
For Count = 1 To objOutlookAddress.Folders.Count
If LCase(objOutlookAddress.Folders(Count).Name) = LCase(strTargetFolder) Then
    Set objOutlookFolder = objOutlookAddress.Folders(Count)
    Exit For
    End If
Next
'search for the folder <strMoveDestFolder> inside of that object
Set objDestMoveFolder = Nothing
For Count = 1 To objOutlookAddress.Folders.Count
If LCase(objOutlookAddress.Folders(Count).Name) = LCase(strDestMoveFolder) Then
    Set objDestMoveFolder = objOutlookAddress.Folders(Count)
    Exit For
End If
Next
'if the folder <strMoveDestFolder> isn't found, create it
If objDestMoveFolder Is Nothing Then
    Set objDestMoveFolder = objOutlookAddress.Folders.Add(strDestMoveFolder)
End If

This part is what moves emails one by one in the For Each loop:

'move email to the <strMoveDestFolder>\<month> <year> folder
strMoveDestSubFolder = Format(Mailobject.ReceivedTime, "mmm yyyy") & ""
'search for the folder <strMoveDestSubFolder> inside of <strMoveDestFolder> folder
Set objDestMoveSubFolder = Nothing
For Count = 1 To objDestMoveFolder.Folders.Count
If LCase(objDestMoveFolder.Folders(Count).Name) = LCase(strMoveDestSubFolder) Then
 Set objDestMoveSubFolder = objDestMoveFolder.Folders(Count)
 Exit For
End If
Next
'if the folder <strMoveDestSubFolder> isn't found, create it
If objDestMoveSubFolder Is Nothing Then
   Set objDestMoveSubFolder = objDestMoveFolder.Folders.Add(strMoveDestSubFolder)
End If
Mailobject.UnRead = False 'mark email as read
Mailobject.Move (objDestMoveSubFolder) 'move mail to the folder

 

[spikepl]

Oh gee, itmust be fun finding the problem with the sparse clues you have provided.

If you want somebody to help you then take the effort to identify offending lines, error message and circumstances.

 

[alexbeatle]

Oh gee, itmust be fun finding the problem with the sparse clues you have provided.

If you want somebody to help you then take the effort to identify offending lines, error message and circumstances.

I do apologise, but this is all I've got.
I know that the rest of the code works fine, since when I cycle through all the emails I mark them as READ and so at the end of the cycle, all of the emails that pass the criteria are marked as READ.
However, when I apply the above code to move the emails to other folders, after sometime (~2000 emails) the code resets and I have to restart it.
Even when I setup error handling as: On Error GoTo errHandler. and put a line breaker inside the errHandler it never reaches it. So I'm really blinded here.