RPC_E_CALL_REJECTED 0x80010001 在 Outlook 上从线程创建新邮件 [英] RPC_E_CALL_REJECTED 0x80010001 on Outlook new Mail creation from Thread

问题描述

当从线程调用此代码时，我收到错误消息 RPC_E_CALL_REJECTED 0x80010001.从代码本身可以看出，我尝试通过递归和其他一些解决方法来处理这个问题，难道没有适当的解决方案吗?

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 = "[e-mail]"

        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

我真的需要它是防弹的，但无论我尝试什么，它都会因另一个错误而失败.该应用程序监视 pdf 文档的六个文件夹(每个文件观察程序是一个单独的线程).将它们添加到池中.在 30 秒的间隔内，它会检查文件名池，并应创建包含所有文件的电子邮件，调用上面的例程，但遇到几个错误，最新的是 RPC_E_CALL... 错误.- 如果我跳过错误电子邮件已发送，但没有附件，则根本无法调用 SyncOutlook().- 在某些机器上，此代码可以完美运行，而在其他机器上，outlook 有加载项，但没有.

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

推荐答案

Outlook 使用单线程单元模型.您不应该从辅助线程使用 OOM.最新的 Outlook 版本可能会检测到此类调用并引发异常.

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.

您可以使用允许运行辅助线程的低级 API - 扩展 MAPI 或围绕该 API 的任何包装器，例如 Redemption.每个使用 MAPI 的线程都必须调用 MAPIInitialise.

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.

在 Redemption 的情况下，在辅助线程上创建 RDOSession 对象的实例，调用 RDOSession.Logon，或者，如果您想确保 Redemption 和Outlook 使用相同的 MAPI 会话，将 RDOSession.MAPIOBJECT 属性设置为 Outlook 中的 Namespace.MAPIOBJECT.

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.

最后，如果您只处理 Exchange 帐户，您可以考虑使用 Exchange Web 服务，请参阅 开始在 Exchange 中使用网络服务以了解更多信息.

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.

这篇关于RPC_E_CALL_REJECTED 0x80010001 在 Outlook 上从线程创建新邮件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！