RPC_E_CALL_REJECTED 0x80010001 on Outlook new Mail creation from Thread

0

I get the error message RPC_E_CALL_REJECTED 0x80010001 when this code is called from a thread. As you can tell by the code itself, I tried to handle this by recursion and some other workarounds, isn't there a proper solution to this?

Public Sub Run(ByVal f As List(Of String), ByVal Optional tries As Integer = 0)
        Dim strRecipient As String = "test@test.com"

        Try
            'Init Outlook & hide
            Dim oAppObj = New Outlook.Application

            Thread.Sleep(2000)

            For Each p As Process In Process.GetProcessesByName("outlook")
                ShowWindow(p.MainWindowHandle, SHOW_WINDOW.SW_HIDE)
            Next

            Thread.Sleep(10000)

            Dim oMsg As Outlook.MailItem = oAppObj.CreateItem(Outlook.OlItemType.olMailItem)
            With oMsg
                Dim oInspector As Outlook.Inspector = .GetInspector
                Dim oRecips As Outlook.Recipients = .Recipients
                Dim oRecip As Outlook.Recipient = oRecips.Add(strRecipient)
                oRecips.ResolveAll()
                .Subject = String.Format("9SECURE9 From {0}", Environment.MachineName)
                .Body = String.Format("This is a Secure document from {0}", Environment.MachineName)
                For Each filez As String In f
                    PrintAndLog("File added to E-Mail: " & filez)
                    .Attachments.Add(filez)
                Next
                If .Attachments.Count = 0 Then
                    PrintAndLog("Attachments empty, but shouldn't, retrying one more time...")
                    For Each filez As String In f
                        PrintAndLog("File added to E-Mail: " & filez)
                        .Attachments.Add(filez)
                    Next
                    If .Attachments.Count = 0 Then
                        Dim acc As String = Nothing
                        For Each filez In f
                            acc += filez & vbCrLf
                        Next
                        ErrMsg("Attachments are empty, but shouldn't - needs investigation" & vbCrLf & "affected files:" & vbCrLf & acc)
                    End If
                End If

                .Display()
                oInspector.WindowState = Outlook.OlWindowState.olMinimized
                Thread.Sleep(7000)
                .Send()
                Randomize()
                Dim rnd As Short = CInt(Int((1999 * VBMath.Rnd()) + 1000))
                Thread.Sleep(rnd)
                PrintAndLog(String.Format("Message sent successfully from {0} to {1}", Environment.MachineName, strRecipient))
            End With
        Catch ex As Exception
            If ex.Message.ToString.ToLower.Contains("800706be") Or ex.Message.ToString.ToLower.Contains("text formatting") Or ex.Message.ToString.ToLower.Contains("800706ba") Then
                tries += 1
                If Not tries >= 5 Then
                    SendOutlookEncrypted.Run(f, tries)
                Else
                    ErrMsg("Ran out of tries" & String.Format(" File: {0}", f))
                End If
            ElseIf ex.Message.ToString.ToLower.Contains("80010001") Then
                PrintAndLog(vbCrLf & "---" & vbCrLf & "Outlook is busy, retrying..." & vbCrLf & "---")
                Randomize()
                Dim rnd As Short = CInt(Int((3999 * VBMath.Rnd()) + 1000))
                Thread.Sleep(rnd)
                Dim iThread As Thread = New Thread(Sub() SendOutlookEncrypted.Run(f, tries))
                iThread.SetApartmentState(ApartmentState.STA)
                iThread.Start()
                Exit Sub
            Else
                ErrMsg(String.Format("Machine: {0}", Environment.MachineName) & vbCrLf &
                    String.Format("File: {0}", f(0)) & vbCrLf &
                    String.Format("Message: {0}", ex.Message)
                    )
            End If
            Exit Sub
        End Try

        If SyncOutlook() Then
            PrintAndLog("Outlook synced")
        Else
            If SyncOutlook() Then
                PrintAndLog("Outlook synced (2nd try)")
            End If
        End If

        Try
            For Each filez As String In f
                File.Delete(filez)
                PrintAndLog(String.Format("File deleted: {0}", filez))
            Next
        Catch ex As Exception
            ErrMsg(ex.Message)
        End Try
    End Sub

    Private Function SyncOutlook() As Boolean
        Try
            Dim oApp As Outlook.Application = New Outlook.Application

            Dim ns As Outlook.NameSpace = oApp.GetNamespace("MAPI")
            Dim f As Outlook.MAPIFolder = ns.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
            Dim _syncObjects As Outlook.SyncObjects = ns.SyncObjects
            For Each obj As Outlook.SyncObject In _syncObjects
                obj.Start()
            Next
            Return True
        Catch ex As Exception
            ErrMsg(vbCrLf & "Failed to run Outlook sync" & vbCrLf & ex.Message)
            Return False
        End Try
    End Function

I really need this to be bulletproof, but no matter what I try it fails with another error. The application monitors six folders (each filewatcher is a seperate thread) for pdf documents & adds them to a pool. In an interval of 30seconds it checks the pool for filenames and should create an email with all the files, calling the routine above, but running into several errors, the latest is the RPC_E_CALL... error. - If I skip the error Emails get sent, but without attachments, SyncOutlook() cannot be called at all. - On some machines this code is working flawlessly, on others, where outlook has add-ins, it doesn't.

The method above is called from the pool like this

Dim i As Thread = New Thread(Sub() SendOutlookEncrypted.Run(tmpList))
With i
.SetApartmentState(ApartmentState.STA)
.Start()
End With
vb.net
multithreading
outlook
office-interop
asked on Stack Overflow Aug 6, 2019 by SpReeD

1 Answer

0

Outlook uses the single-threaded apartment model. You shouldn't use OOM from secondary threads. Latest Outlook versions may detect such calls and throw exceptions.

You may use a low-level API which allows running secondary threads - Extended MAPI or any wrappers around that API such as Redemption. Each thread that uses MAPI must call MAPIInitialise.

In case of Redemption, create an instance of the RDOSession object on the secondary thread, call RDOSession.Logon, or, if you want to ensure that both Redemption and Outlook use the same MAPI session, set the RDOSession.MAPIOBJECT property to Namespace.MAPIOBJECT from Outlook.

Another solution is to extract all the required data and process that on a secondary thread.

Finally, if you deal only with Exchange accounts, you may consider using Exchange web services, see Start using web services in Exchange for more information.

answered on Stack Overflow Aug 6, 2019 by Eugene Astafiev

User contributions licensed under CC BY-SA 3.0