Vba vba运行时错误-1802485755（94904005）[重复]

Question

我有一个奇怪的问题，vba给我返回错误vba运行时错误-1802485755(94904005)，我在互联网上搜索但什么也没找到，所以我想在这里询问是否有人可以帮助我

这是代码

Private Sub CommandButton3_Click()
    Dim str As New Classe1
    Dim ricerca As String
    Dim dmi As outlook.MailItem
    Dim UTCdate As Date, UTCdate2 As Date
    Dim out As outlook.Application
    Dim DATA1 As Date
    Dim DATA2 As Date
    Dim errorN As Long
    
    On Error GoTo FormatoErrato:
    DATA1 = DateAdd("h", 1, Res.DataStart.Value)
    DATA2 = DateAdd("h", 23, Res.DataEnd.Value)
    On Error GoTo 0
    Set out = New outlook.Application
    Set dmi = out.CreateItem(olMailItem)
    
    UTCdate = dmi.PropertyAccessor.LocalTimeToUTC(DATA1)
    UTCdate2 = dmi.PropertyAccessor.LocalTimeToUTC(DATA2)
    
    ricerca = "@SQL=""urn:schemas:httpmail:subject"" LIKE '%sometext%'" & _
    " AND ""urn:schemas:httpmail:datereceived"" <= '" & UTCdate2 & "'" & _
    " AND ""urn:schemas:httpmail:datereceived"" >= '" & UTCdate & "'"
    
    str.prova (ricerca)

FormatoErrato:
    errorN = Err.Number
    If errorN = 13 Then
        MsgBox "invalid format", vbCritical
    End If
End Sub

此代码（在类模块中）位于用户表单按钮上，您可以在其中设置两个日期，然后以下代码搜索符合要求的电子邮件

Sub prova(val As String)
    Res.Mezzi.Clear
    
    Dim fol As outlook.Folder
    Dim arr, arr2
    Dim ricerca As String, txt As String
    Dim n As Long, s As Long, tot As Long, l As Long
    Dim mi As outlook.MailItem
    Dim i As Object
    Dim doc As Word.Document
    
    Set fol = 'outlook folder path'
    s = 0
    n = 1
    
    ReDim Preserve arr2(0 To s)
    
    For Each i In fol.Items.Restrict(val)
        If i.Class = olMail Then
        Set mi = i
    
        Set doc = mi.GetInspector.WordEditor
            If doc.Tables.Count > 0 Then
                For tot = 1 To doc.Tables.Count
                    arr2(s) = Application.WorksheetFunction.Clean(doc.Tables(tot).Cell(2, 2).Range.Text)
                    s = s + 1
                    ReDim Preserve arr2(0 To s)
                Next tot
            End If
        End If
    Next i
    
    For s = 0 To UBound(arr2)
        If IsEmpty(arr2(s)) = False And arr2(s) <> "" Then
            Res.Mezzi.AddItem arr2(s)
        End If
    Next s
End Sub

我正在查找的电子邮件有一个表，其中有一个或多个表，因此我使用 getinspector.wordeditor 来检查该表是否存在，然后从中获取我需要的数据。

如果日期之间的差异只有几天，如果我输入一周给出该错误，则子工作正常

你能帮我解决问题或解决它吗？

提前致谢

Answer 1

我没有找到任何信息系统上安装了哪个Office版本。因此，如果您安装了相当旧版本的 MS Office，则以下情况是有意义的 - 仅当

WordEditor

方法返回

IsWordMail

并且

True

属性为

EditorType

时，

olEditorWord

属性才有效。

运行时出现此类错误的最可能原因是处理 Outlook 对象模型时的安全设置。邮件正文是 Outlook 对象模型中受保护的属性，当 Outlook 从外部应用程序自动化时，可能会生成错误。您可以在“受保护的属性和方法”页面上找到描述的受保护属性的列表。 因此，当不受信任的应用程序尝试使用对象模型获取电子邮件地址信息、在 Outlook 外部存储数据、执行某些操作以及发送电子邮件时，对象模型防护会向用户发出警告并提示用户进行确认。如果由于任何原因警告不合适或无法显示，则 Outlook 对象模型在访问受保护的属性时可能会生成错误。

在您的场景中，您可以：

使用不会在 Outlook 对象模型中触发安全问题的低级 API - 扩展 MAPI 或围绕该 API 的任何其他第三方包装器。

1. 创建一个 COM 加载项，该加载项可以访问受信任的应用程序对象并且不会触发安全问题。
2. 安装任何具有最新更新的 AV。
3. 使用组策略设置来设置安全设置，以免触发安全问题。

Answer 2

为了避免引发错误，我应该关闭检查器。

这样：

If i.Class = olMail Then
    Set mi = i
    Set insp = mi.GetInspector
    Set doc = insp.WordEditor
        If doc.Tables.Count > 0 Then
            For tot = 1 To doc.Tables.Count
                arr2(s) = Application.WorksheetFunction.Clean(doc.Tables(tot).Cell(2, 2).Range.Text)
                s = s + 1
                ReDim Preserve arr2(0 To s)
            Next tot
        End If
    End If
     insp.Close olSave

现在，即使是 10 天的电子邮件，一切似乎都工作正常