outlook addin CRASH Runtime error 2147417856 (80010100); Automation error

[Oliv-]

Hi,
My OUTLOOK ADD-IN regulary crash with
Run-time error '-2147417856 (80010100)':
Automation error
the AUTOMATION ERROR is about OUTLOOK !

It is a VB6 add-in's, to process a lot of emails (300 to 1000) , save Email and ATTACHMENTS to PDF.

In my treatment, i use also WORD by automation and "pdfforge.tools"

this is my onconnection

Private WithEvents objOLApp As Outlook.application

Public Sub IDTExtensibility2_OnConnection(ByVal application As Object, _
                                          ByVal connectMode As ext_ConnectMode, ByVal addInInst As Object, custom() As Variant)

    On Error GoTo AddinInstance_OnConnection_Error
    Set objOLApp = application
'...
        Set g_objOL = objOLApp
        Set g_objNS = objOLApp.GetNamespace("MAPI")

in a general module

Public g_objOL As Outlook.application
Public g_objNS As Outlook.NameSpace

this is my first SUB

Sub Go_ActionGS(Motif As String)
'objBtnExpPrintPJ_Click

' On Error GoTo Go_ActionGS_Error

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set WordApp = CreateObject("Word.application")

    GROUPES = Array("A", "B", "C")
   '...
    Dim ObjFirstFolder As Outlook.Folder
    Set ObjFirstFolder = GetFolder(FirstFolder)
    If ObjFirstFolder Is Nothing Then Exit Sub
    octu_attente.Show

    '#################### ETAPE 1  ###################
    '######## on traite tous les EMAILS et PJ ########
    '#################################################
    Call ProcessFolderPRINT_TO_PDF(ObjFirstFolder)


    '#################### ETAPE 2  ###################
    '######## on traite tous DOSSIERS TEMPORAIRES ####
    '#################################################
'...

    ' On Error GoTo 0
    MsgBox NbPjImp & "/" & NbPj & " Impressions lancées sur " & Imprimante & vbCr & "Emails traités : " & NbEmail
    Set FSO = Nothing
    WordApp.Quit
    Set WordApp = Nothing
    Unload octu_attente

    ' On Error GoTo 0
    Exit Sub

Go_ActionGS_Error:
'...
End Sub

Function GetFolder(ByVal FolderPath As String) As Outlook.Folder
    Dim TestFolder As Outlook.Folder
    Dim FoldersArray As Variant
    Dim i As Integer

    ' On Error GoTo GetFolder_Error
    If Left(FolderPath, 2) = "\\" Then
        FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    Set TestFolder = g_objOL.Session.Folders.Item(FoldersArray(0))
    If Not TestFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.Folders
            Set SubFolders = TestFolder.Folders
            Set TestFolder = SubFolders.Item(FoldersArray(i))
            If TestFolder Is Nothing Then
                Set GetFolder = Nothing
            End If
        Next
    End If
    'Return the TestFolder
    Set GetFolder = TestFolder
    Exit Function

GetFolder_Error:
    Set GetFolder = Nothing
    Exit Function
End Function

Sub ProcessFolderPRINT_TO_PDF(StartFolder As Outlook.MAPIFolder)
    Dim objFolder As Outlook.MAPIFolder
    Dim oMailItem As Outlook.MailItem
    Dim oItem As Object
    Dim Motif As String
    'Dim objItem As Object
    'On Error Resume Next

    ' do something specific with this folder
    Debug.Print StartFolder.FolderPath, StartFolder.Folders.Count, StartFolder.Items.Count
    Debug.Print
    If StartFolder.Name <> SubDossierImprimés And StartFolder.Name <> SubDossierAnomalies Then
        octu_attente.Label1.Caption = "Traitement de " & StartFolder.Name & "(" & StartFolder.FolderPath & ")"
        '#VBA
        'octu_attente.Repaint
    octu_attente.Refresh
    
        ' On Error GoTo 0
        Dim i
        For i = StartFolder.Items.Count To 1 Step -1
            Set oItem = StartFolder.Items(i)
            If oItem.Class = olMail Then

                Set oMailItem = oItem
     '...
                    MsgActionGS oMailItem, Motif
          
                Set oMailItem = Nothing
            End If
suite:
        DoEvents
        Next i    'oItem
        For Each objFolder In StartFolder.Folders
            ' On Error GoTo 0
            Call ProcessFolderPRINT_TO_PDF(objFolder)
        Next
    End If
    Set objFolder = Nothing
End Sub

It's look like a TIMEOUT ! and if i use VBA with this code i have no problem.

My code in very large 1500 lines i can't publish it.

Thank you for your help.