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。worddeditor检查表是否存在，然后从中获取我需要的数据。

如果日期之间的差异只有几天，子程序可以正常工作如果我输入一个星期，则会出现错误

你能帮我解决这个问题吗?thanks in advance

Answer 1

我没有找到系统上安装的Office版本的任何信息。所以，如果你安装的是旧版本的MS Office，下面的情况是有意义的-WordEditor属性只有在IsWordMail方法返回True并且EditorType属性为olEditorWord时才有效。

在运行时出现此类错误的最可能原因是处理Outlook对象模型时的安全设置。消息体是Outlook对象模型中受保护的属性，当从外部应用程序自动执行Outlook时，该属性可能会生成错误。您可以在受保护的属性和方法页面中找到描述的受保护属性列表。

因此，当不受信任的应用程序试图使用对象模型获取电子邮件地址信息、在Outlook外部存储数据、执行某些操作和发送电子邮件消息时，对象模型警卫会警告用户并提示用户进行确认。如果由于任何原因，警告不合适或不能显示，Outlook对象模型在访问受保护的属性时可能会生成错误。

在您的场景中，您可以:

1. 使用不会在Outlook对象模型中触发安全问题的低级API -扩展MAPI或任何其他第三方API包装器。
2. 创建一个COM外接程序，它可以访问受信任的Application对象，并且不会触发安全问题。
3. 安装任何带有最新更新的AV。
4. 使用组策略设置设置安全设置，不触发安全问题。

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天的电子邮件范围