Error accessing 2 shared outlook mailboxes at the same time

[Lehman]

I have 2 shared mailboxes where I retrieve the count of the mails. These 2 shared mailboxes have 2 different mailaddresses. When I combine these 2 codes, it gives the following error:

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">Run-time error -<wbr style="color: rgb(84, 84, 84); font-family: arial, sans-serif; font-size: 14px;">2147221219 (8004011d)
The operation failed because of a registry or installation problem. Restart Outlook andtry again.If the problem persists, reinstall.</code>
<time itemprop="dateCreated" datetime="2017-08-31T11:38:02" style="margin: 0px; padding: 0px; border: 0px; font-variant-numeric: inherit; font-variant-east-asian: inherit; font-stretch: inherit; line-height: inherit; font-family: Arial, "Helvetica Neue", Helvetica, sans-serif; vertical-align: baseline; box-sizing: inherit; color: rgb(36, 39, 41);"></time>

I believe it has something to do with committing the outlook application to one code but I am not sure. My code is as follows:
Code1:

Sub GetFromOutlook()
Dim OutlookApp1 As Outlook.Application
Dim oaccount As Outlook.Account
    Dim OutlookNamespace As Namespace
    Dim ostore As Outlook.Store
    Dim Folder As MAPIFolder
    Dim OutlookMail As Variant
    Dim i As Integer   
    accName = "support@company.com"
    Set OutlookApp1 = New Outlook.Application
    Set OutlookNamespace = OutlookApp1.GetNamespace("MAPI")
   
    Set objOwner = OutlookNamespace.CreateRecipient(accName)
    objOwner.Resolve
    
    If objOwner.Resolved Then
        Set Folder = OutlookNamespace.GetSharedDefaultFolder(objOwner, olFolderInbox).Folders("IL").Folders("5")
        i = 0
        For Each OutlookMail In Folder.Items
            If TypeOf OutlookMail Is MailItem Then
                i = i + 1
            End If
        Next OutlookMail        
        LastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
        Sheet1.Cells(LastRow + 1, 1).Value = i        
    End If    
    Set Folder = Nothing
    Set OutlookNamespace = Nothing
    Set OutlookApp1 = Nothing
End Sub

Code2:

Sub GetFromOutlook()
Dim OutlookApp As Outlook.Application
Dim oaccount As Outlook.Account
    Dim OutlookNamespace As Namespace
    Dim ostore As Outlook.Store
    Dim Folder As MAPIFolder
    Dim OutlookMail As Variant
    Dim i As Integer
    Dim acc_folders, acc_subfolders, foldersCount As Variant
    accName = "support-sales@company.com"
    acc_folders = Array("2.Test", "4. Test", "9. Test")
    acc_subfolders = Array("A2", "A4", "A9")
    foldersCount = Array(3)
    Set OutlookApp = New Outlook.Application
    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
    
    Set objOwner = OutlookNamespace.CreateRecipient(accName)
    objOwner.Resolve
    
    indexFolder = LBound(acc_folders)
    kk = LBound(foldersCount)
    colIndex = 1
    LastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    If objOwner.Resolved Then
        For aa = indexFolder To (indexFolder + foldersCount(kk) - 1)
            Set Folder = OutlookNamespace.GetSharedDefaultFolder(objOwner, olFolderInbox).Parent
            Set SubFolder = Folder.Folders(acc_folders(aa))
            Set SubSubFolder = SubFolder.Folders(acc_subfolders(aa))
            i = 0
    
            For Each OutlookMail In SubSubFolder.Items
                If TypeOf OutlookMail Is MailItem Then
                    curTime = Now
                    If Year(OutlookMail.ReceivedTime) = Year(curTime) And Month(OutlookMail.ReceivedTime) = Month(curTime) And Day(OutlookMail.ReceivedTime) >= (Day(curTime) - 3) Then
                        i = i + 1
                    End If
                End If
            Next OutlookMail
            
            Sheet1.Cells(LastRow + 1, colIndex).Value = i
            colIndex = colIndex + 1
        Next aa
    End If
    
    Set Folder = Nothing
    Set OutlookNamespace = Nothing
    Set OutlookApp = Nothing
End Sub

Is there someone who can shed light on this problem?

 

[Lehman]

Guys, is er someone with a possible solution? In Python I would use multiprocessing however how to solve this problem in excel?

 

[Lehman]

Solved, I was using the cached mode !